I need some help trying to figure out how to make the code below recursive using only lambdas.
(define (mklist2 bind pure args)
(define (helper bnd pr ttl lst)
(cond [(empty? lst) (pure ttl)]
[else (define (func t) (helper bnd pr (append ttl (list t)) (rest lst)))
(bind (first lst) func)])
)
(helper bind pure empty args))
Given a sample factorial program -
(define fact
(lambda (n)
(if (= n 0)
1
(* n (fact (- n 1)))))) ;; goal: remove reference to `fact`
(print (fact 7)) ; 5040
Above fact is (lambda (n) ...) and when we call fact we are asking for this lambda so we can reapply it with new arguments. lambda are nameless and if we cannot use top-level define bindings, the only way to bind a variable is using a lambda's parameter. Imagine something like -
(lambda (r)
; ...lambda body...
; call (r ...) to recur this lambda
)
We just need something to make our (lambda (r) ...) behave this way -
(something (lambda (r)
(print 1)
(r)))
; 1
; 1
; 1
; ... forever
introducing U
This something is quite close to the U combinator -
(define u
(lambda (f) (f f)))
(define fact
(lambda (r) ;; wrap in (lambda (r) ...)
(lambda (n)
(if (= n 0)
1
(* n ((r r) (- n 1))))))) ;; replace fact with (r r)
(print ((u fact) 7))
; => 5040
And now that recursion is happening thru use of a parameter, we could effectively remove all define bindings and write it using only lambda -
; ((u fact) 7)
(print (((lambda (f) (f f)) ; u
(lambda (r) ; fact
(lambda (n)
(if (= n 0)
1
(* n ((r r) (- n 1)))))))
7))
; => 5040
Why U when you can Y?
The U-combinator is simple but having to call ((r r) ...) inside the function is cumbersome. It'd be nice if you could call (r ...) to recur directly. This is exactly what the Y-combinator does -
(define y
(lambda (f)
(f (lambda (x) ((y f) x))))) ;; pass (y f) to user lambda
(define fact
(lambda (recur)
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1))))))) ;; recur directly
(print ((y fact) 7))
; => 5040
But see how y has a by-name recursive definition? We can use u to remove the by-name reference and recur using a lambda parameter instead. The same as we did above -
(define u
(lambda (f) (f f)))
(define y
(lambda (r) ;; wrap in (lambda (r) ...)
(lambda (f)
(f (lambda (x) (((r r) f) x)))))) ;; replace y with (r r)
(define fact
(lambda (recur)
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1)))))))
(print (((u y) fact) 7)) ;; replace y with (u y)
; => 5040
We can write it now using only lambda -
; (((u y) fact) 7)
(print ((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (recur) ; fact
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1)))))))
7))
; => 5040
need more parameters?
By using currying, we can expand our functions to support more parameters, if needed -
(define range
(lambda (r)
(lambda (start)
(lambda (end)
(if (> start end)
null
(cons start ((r (add1 start)) end)))))))
(define map
(lambda (r)
(lambda (f)
(lambda (l)
(if (null? l)
null
(cons (f (car l))
((r f) (cdr l))))))))
(define nums
((((u y) range) 3) 9))
(define squares
((((u y) map) (lambda (x) (* x x))) nums))
(print squares)
; '(9 16 25 36 49 64 81)
And as a single lambda expression -
; ((((u y) map) (lambda (x) (* x x))) ((((u y) range) 3) 9))
(print (((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (r) ; map
(lambda (f)
(lambda (l)
(if (null? l)
null
(cons (f (car l))
((r f) (cdr l))))))))
(lambda (x) (* x x))) ; square
(((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (r) ; range
(lambda (start)
(lambda (end)
(if (> start end)
null
(cons start ((r (add1 start)) end)))))))
3) ; start
9))) ; end
; => '(9 16 25 36 49 64 81)
lazY
Check out these cool implementations of y using lazy
#lang lazy
(define y
(lambda (f)
(f (y f))))
#lang lazy
(define y
((lambda (f) (f f)) ; u
(lambda (r)
(lambda (f)
(f ((r r) f))))))
#lang lazy
(define y
((lambda (r)
(lambda (f)
(f ((r r) f))))
(lambda (r)
(lambda (f)
(f ((r r) f))))))
In response to #alinsoar's answer, I just wanted to show that Typed Racket's type system can express the Y combinator, if you put the proper type annotations using Rec types.
The U combinator requires a Rec type for its argument:
(: u (All (a) (-> (Rec F (-> F a)) a)))
(define u
(lambda (f) (f f)))
The Y combinator itself doesn't need a Rec in its type:
(: y (All (a b) (-> (-> (-> a b) (-> a b)) (-> a b))))
However, the definition of the Y combinator requires a Rec type annotation on one of the functions used within it:
(: y (All (a b) (-> (-> (-> a b) (-> a b)) (-> a b))))
(define y
(lambda (f)
(u (lambda ([g : (Rec G (-> G (-> a b)))])
(f (lambda (x) ((g g) x)))))))
Recursion using only lambdas can be done using fixed point combinators, the simplest one being Ω.
However, take into account that such a combinator has a type of infinite length, so if you program with types, the type is recursive and has infinite length. Not every type checker is able to compute the type for recursive types. The type checker of Racket I think it's Hindley-Miller and I remember typed racket it's not able to run fixed point combinators, but not sure. You have to disable the type checker for this to work.
Related
If I have a recursive function like this:
(define (double-n-times x n)
(if (= n 0)
x
(double-n-times (* 2 x) (- n 1))))
How can I make a lambda version of it and never give it a name? ... like if i want to inline it somewhere. Is that possible? (I mean in this case I could use fold - so maybe the example isn't that great) - Is there some kind of symbol or placeholder for "self" that I haven't been able to find? Or do you just have to give it a name.
The Y-Combinator in Racket is:
(lambda (f)
((lambda (h) (h h))
(lambda (g) (f (lambda args (apply (g g) args))))))
This function can take any anonymous function and apply it on themselves recursively.
Let us define your function's part. double-n-times-part written only with lambdas:
(lambda (f)
(lambda (x n)
(if (= n 0) x (f (* 2 x) (- n 1))))))
where f we could name as we want - so we could also call it double-n-part.
If we apply the Y-Combinator on this, we get:
((lambda (f)
((lambda (h) (h h))
(lambda (g) (f (lambda args (apply (g g) args))))))
(lambda (f)
(lambda (x n)
(if (= n 0) x (f (* 2 x) (- n 1))))))
This spits out a function which takes the arguments x and n and applies the inner function of the second definiton on them.
So now, without any named functions - only using lambda expressions - you can apply on your arguments - let's say x=3 and n=4:
(((lambda (f)
((lambda (h) (h h))
(lambda (g) (f (lambda args (apply (g g) args))))))
(lambda (f)
(lambda (x n)
(if (= n 0) x (f (* 2 x) (- n 1))))))
3 4)
;;=> 48 ; as expected (3 * 2 * 2 * 2 * 2)
This is more convenient to read.
But we could also define the Y combinator without apply and args when we allow only monadic functions (functions with one arguments) instead of variadic ones. Then it looks like this (and we have to give the arguments one after another like this):
((((lambda (f)
((lambda (h) (h h))
(lambda (g) (f (lambda (x) ((g g) x))))))
(lambda (f)
(lambda (x)
(lambda (n)
(if (= n 0) x ((f (* 2 x)) (- n 1)))))))
3) 4)
;;=> 48
The answer to your question is yes, by using macros. But before I talk about that, I have to ask this first: do you ask because you are just curious? Or do you ask because there are some issues, like you don't want to pollute the namespace with names?
If you don't want to pollute the namespace with names, you can simply use local constructs like named let, letrec, or even Y combinator. Alternatively, you can wrap define inside (let () ...).
(let ()
(define (double-n-times x n)
(if (= n 0)
x
(double-n-times (* 2 x) (- n 1))))
(double-n-times 10 10))
;; double-n-times is not in scope here
For the actual answer: here's a macro rlam that is similar to lambda, but it allows you to use self to refer to itself:
#lang racket
(require syntax/parse/define)
(define-syntax-parse-rule (rlam args body ...+)
#:with self (datum->syntax this-syntax 'self)
(letrec ([self (λ args body ...)])
self))
;; compute factorial of 10
((rlam (x)
(if (= 0 x)
1
(* x (self (sub1 x))))) 10) ;=> 3628800
Yes. Being a placeholder for a name is what lambda function's parameters are there for:
(define (double-n-times x n)
(if (= n 0)
x
(double-n-times (* 2 x) (- n 1))))
=
(define double-n-times (lambda (x n)
(if (= n 0)
x
(double-n-times (* 2 x) (- n 1)))))
=
(define double-n-times (lambda (self) ;; received here
(lambda (x n)
(if (= n 0)
x
(self (* 2 x) (- n 1)))))) ;; and used, here
but what is this "self" parameter? It is the lambda function itself :
= ;; this one's in error...
(define double-n-times ((lambda (u) ;; call self with self
(u u)) ;; to receive self as an argument
(lambda (self)
(lambda (x n)
(if (= n 0)
x
(self (* 2 x) (- n 1)))))))
;; ...can you see where and why?
= ;; this one isn't:
(define double-n-times ((lambda (u) (u u))
(lambda (self)
(lambda (x n)
(if (= n 0)
x
((self self) (* 2 x) (- n 1)))))))
;; need to call self with self to actually get that
;; (lambda (x n) ... ) thing to be applied to the values!
And now it works: (double-n-times 1.5 2) returns 6.0.
This is already fine and dandy, but we had to write ((self self) ... ...) there to express the binary recursive call. Can we do better? Can we write the lambda function with the regular (self ... ...) call syntax as before? Let's see. Is it
= ;; erroneous
(define double-n-times ((lambda (u) (u u))
(lambda (self)
(lambda (x n)
(lambda (rec body) (self self)
(if (= n 0)
x
(rec (* 2 x) (- n 1))))))))
(no) Or is it
= ;; also erroneous...
(define double-n-times ((lambda (u) (u u))
(lambda (self)
(lambda (x n)
((lambda (rec body) body)
(self self)
(if (= n 0)
x
(rec (* 2 x) (- n 1)))))))) ;; ...can you see why?
(still no) Or is it perhaps
= ;; still erroneous...
(define double-n-times ((lambda (u) (u u))
(lambda (self)
((lambda (rec)
(lambda (x n)
(if (= n 0)
x
(rec (* 2 x) (- n 1)))))
(self self) ))))
(no yet again ... in an interesting way) Or is it actually
=
(define double-n-times ((lambda (u) (u u))
(lambda (self)
((lambda (rec)
(lambda (x n)
(if (= n 0)
x
(rec (* 2 x) (- n 1)))))
(lambda (a b) ((self self) a b)) ))))
(yes!) such that it can be abstracted and separated into
(define (Y2 g) ((lambda (u) (u u))
(lambda (self)
(g
(lambda (a b) ((self self) a b))))))
(define double-n-times (Y2
(lambda (rec) ;; declare the rec call name
(lambda (x n)
(if (= n 0)
x
(rec (* 2 x) (- n 1))))))) ;; and use it to make the call
and there we have it, the Y combinator for binary functions under strict evaluation strategy of Scheme.
Thus we first close over our binary lambda function with our chosen recursive call name, then use the Y2 combinator to transform this "rec spec" nested lambdas into a plain callable binary lambda function (i.e. such that expects two arguments).
Or course the name rec itself is of no importance as long as it does not interfere with the other names in our code. In particular the above could also be written as
(define double-n-times ;; globally visible name
(Y2
(lambda (double-n-times) ;; separate binding,
(lambda (x n) ;; invisible from
(if (= n 0) ;; the outside
x
(double-n-times (* 2 x) (- n 1))))))) ;; original code, unchanged
defining exactly the same function as the result.
This way we didn't have to change our original code at all, just close it over with another lambda parameter with the same name as the name of our intended recursive call, double-n-times, thus making this binding anonymous, i.e. making that name unobservable from the outside; and then passing that through the Y2 combinator.
Of course Scheme already has recursive bindings, and we can achieve the same effect by using letrec:
(define double-n-times ;; globally visible name
(letrec ((double-n-times ;; internal recursive binding:
(lambda (x n) ;; its value, (lambda (x n) ...)
(if (= n 0)
x
(double-n-times (* 2 x) (- n 1))))))
double-n-times)) ;; internal binding's value
Again the internal and the global names are independent of each other.
This is what my wason-deck produces:
((15 . D) (35 . H) (3 . B) (19 . K) (L . 15) (A . 16) (T . 23) (R . 53)
(N . 13) (M . 7) (I . 52) (35 . Q) (S . 19) (Y . 29) (45 . G) (44 . W)
(11 . V) (J . 25) (21 . F) (39 . Z) (25 . X) (50 . E) (5 . P) (33 . C)
(O . 34))
this being a list of pairs representing a Wason deck. (See this, Example 6). In the deck there should be all the letters of the alphabet matched with even or odd numbers depending on whether a vowel or consonant respectively. I randomly shuffle and flip the cards as you can see. Then I (optionally) randomly pollute the deck by occasionally breaking the vowel:even, consonant:odd rule. Here's the code I've come up with:
(defun wason-deck (&optional (p 0))
"This `consolst` and `vowlist` building is unnecessary, but a good exercise"
(let* ((alphab '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(consonents '(b c d f g h j k l m n p q r s t v w x y z))
(consolst (remove 'NIL (mapcar (lambda (x) (find x consonents)) alphab)))
(vowlst (remove 'NIL (mapcar (lambda (x) (find x '(a e i o))) alphab)))
(wdeck '()))
(labels ((make-consodeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (evenp num)
(1+ num)
num)))) consolst))
(make-voweldeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (oddp num)
(1+ num)
num)))) vowlst))
(swap (slst el1 el2)
(let ((tmp (elt slst el1)))
(setf (elt slst el1) (elt slst el2))
(setf (elt slst el2) tmp)))
(shuffle (slst)
(loop for i in (reverse (range (length slst) :min 1))
do (let ((j (random (+ i 1))))
(swap slst i j)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append (make-consodeck) (make-voweldeck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck)))))
It works, but what I fear is not really knowing what I'm doing, i.e., I've misused labels as well as done a setf in the code. If some of the more senior people could tell me whether this is totally off in the wrong direction or not.
Addendum:
This is what I've got after the suggestions from below:
(defun wason-deck3 (&optional (p 0))
(let* ((consonents '(b c d f g h j k l m n p q r s t v w x y z))
(vowels '(a e i o u))
(conso-deck (mapcar (lambda (x)
(cons x (1+ (* 2 (random 27)))))
consonents))
(vowel-deck (mapcar (lambda (x)
(cons x (* 2 (random 27))))
vowels))
(wdeck '()))
(labels
((shuffle (slst)
(loop :for i :from (1- (length slst)) :downto 1
:do (rotatef (nth i slst)
(nth (random (1+ i)) slst)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append conso-deck vowel-deck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck))))
Please add any new suggestions.
Using labels is totally OK, and your code is not entirely unreasonable.
A few pointers:
I'd represent characters as characters: '(#\a #\b #\c …)
I'd take my list exercises elsewhere, or at least use set-difference.
When you create a function for just one call, you might as well just save the result:
(let ((consonant-deck (mapcar (lambda (c)
(cons c (1+ (* 2 (random 27)))))
consonants))
(vowel-deck (mapcar (lambda (c)
(cons c (* 2 (random 27))))
vowels)))
…)
For swapping, there is rotatef: (rotatef (nth i list) (nth j list)). Such things are rather expensive on lists, so I'd prefer to use a vector for this. Then it comes in handy that a string is just a vector of characters…
Loop can do counting for you, you don't need to create lists:
(loop :for i :from (1- (length list)) :downto 1
:do (rotatef (nth i list)
(nth (random (1+ i)) list)))
(Using keywords as loop keywords is optional, but indentation should be like this.)
If you put the labels around the let, you can immediately bind wdeck, so that you do not need to setf it afterwards.
You do not need this function for the exercise that you linked to.
I am trying to build the built-in procedure build-list in Racket.
The built-in function works like this:
(build-list 10 (lambda (x) (* x x)))
>> '(0 1 4 9 16 25 36 49 64 81)
My implementation is a recursive definition for a recursive procedure:
(define (my-build-list-recur list-len proc)
(if (= list-len 0)
'()
(cons (proc (sub1 list-len)) (my-build-list-recur (sub1 list-len) proc))))
When I call my implementation, I have:
(my-build-list-recur 10 (lambda (x) (* x x)))
>> '(81 64 49 36 25 16 9 4 1 0)
As you might have seen, I get the same result, but in a reverse order.
What can I do to have the result in the same order as the native function?
P.S.: I have done an implementation using a recursive definition for an iterative procedure which works perfectly. I am struggling now to generate the same result with the totally recursive procedure. I already know how to solve this doubt with long tail recursion.
This is my implementation with long tail recursion:
(define (my-build-list list-len proc)
(define (iter list-len accu n)
(if (= (length accu) list-len)
(reverse accu)
(iter list-len (cons (proc n) accu) (add1 n))))
;(trace iter)
(iter list-len '() 0))
Ok so you're looking for an answer that does not use state variables and a tail call. You want for a recursive procedure that also evolves a recursive process. Not sure why you want this other than just to see how the definition would differ. You should also read about tail recursion modulo cons (here, and on wikipedia) – it's relevant to this question.
;; recursive procedure, recursive process
(define (build-list n f)
(define (aux m)
(if (equal? m n)
empty
(cons (f m) (aux (add1 m)))))
(aux 0))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
Notice how the aux call is no longer in tail position – ie, cons cannot finish evaluating until it has evaluated the aux call in its arguments. The process will look something like this, evolving on the stack:
(cons (f 0) ...)
(cons (f 0) (cons (f 1) ...))
(cons (f 0) (cons (f 1) (cons (f 2) ...)))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) ...))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) ...)))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) empty)))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) '())))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) '(16)))))
(cons (f 0) (cons (f 1) (cons (f 2) '(9 16))))
(cons (f 0) (cons (f 1) '(4 9 16)))
(cons (f 0) '(1 4 9 16))
'(0 1 4 9 16)
You'll see that the cons calls are left hanging open until ... is filled in. And the last ... isn't filled in with empty until m is equal to n.
If you don't like the inner aux procedure, you can use a default parameter, but this does leak some of the private API to the public API. Maybe it's useful to you and/or maybe you don't really care.
;; recursive procedure, recursive process
(define (build-list n f (m 0))
(if (equal? m n)
'()
(cons (f m) (build-list n f (add1 m)))))
;; still only apply build-list with 2 arguments
(build-list 5 (lambda (x) (* x x)))
;; => '(0 1 4 9 16)
;; if a user wanted, they could start `m` at a different initial value
;; this is what i mean by "leaked" private API
(build-list 5 (lambda (x) (* x x) 3)
;; => '(9 16)
Stack-safe implementations
Why you'd specifically want a recursive process (one which grows the stack) is strange, imo, especially considering how easy it is to write a stack-safe build-list procedure which doesn't grow the stack. Here's some recursive procedures with a linear iterative processes.
The first one is extremely simple but does leak a little bit of private API using the acc parameter. You could easily fix this using an aux procedure like we did in the first solution.
;; recursive procedure, iterative process
(define (build-list n f (acc empty))
(if (equal? 0 n)
acc
(build-list (sub1 n) f (cons (f (sub1 n)) acc))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
Check out the evolved process
(cons (f 4) empty)
(cons (f 3) '(16))
(cons (f 2) '(9 16))
(cons (f 1) '(4 9 16))
(cons (f 0) '(1 4 9 16))
;; => '(0 1 4 9 16)
This is insanely better because it can constantly reuse one stack frame until the entire list is built. As an added advantage, we don't need to keep a counter that goes from 0 up to n. Instead, we build the list backwards and count from n-1 to 0.
Lastly, here's another recursive procedure that evolves a linear iterative process. It utilizes a named-let and continuation passing style. The loop helps prevent leaking the API this time.
;; recursive procedure, iterative process
(define (build-list n f)
(let loop ((m 0) (k identity))
(if (equal? n m)
(k empty)
(loop (add1 m) (λ (rest) (k (cons (f m) rest)))))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
It cleans up a little tho if you use compose and curry:
;; recursive procedure, iterative process
(define (build-list n f)
(let loop ((m 0) (k identity))
(if (equal? n m)
(k empty)
(loop (add1 m) (compose k (curry cons (f m)))))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
The process evolved from this procedure is slightly different, but you'll notice that it also doesn't grow the stack, creating a sequence of nested lambdas on the heap instead. So this would be sufficient for sufficiently large values of n:
(loop 0 identity) ; k0
(loop 1 (λ (x) (k0 (cons (f 0) x))) ; k1
(loop 2 (λ (x) (k1 (cons (f 1) x))) ; k2
(loop 3 (λ (x) (k2 (cons (f 2) x))) ; k3
(loop 4 (λ (x) (k3 (cons (f 3) x))) ; k4
(loop 5 (λ (x) (k4 (cons (f 4) x))) ; k5
(k5 empty)
(k4 (cons 16 empty))
(k3 (cons 9 '(16)))
(k2 (cons 4 '(9 16)))
(k1 (cons 1 '(4 9 16)))
(k0 (cons 0 '(1 4 9 16)))
(identity '(0 1 4 9 16))
'(0 1 4 9 16)
I want to write a function/macro
(defun apply-funcs (functions value) ...)
so that calling (apply-funcs (list #'f #'g #'h) x) will do the equivalent of (h (g (f x))). How can this be accomplished?
Looks like you want to reduce a list of functions over a value.
CL-USER> (defun apply-funcs (functions value)
(reduce (lambda (memo fn) (funcall fn memo))
functions :initial-value value))
CL-USER> (apply-funcs
(list (lambda (n) (+ 3 n))
(lambda (n) (- n 2))
(lambda (n) (* 2 n)))
6)
14
CL-USER>
You may know reduce as fold from other languages. I'm using funcall instead of apply because of what you've said you want above ((apply-funcs (list #'f #'g #'h) x) => (h (g (f x)))). You'd use apply if x were a list of values, each element of which you wanted to bind to a separate argument. For instance, if you wanted to do something like
(apply-funcs
(list (lambda (a b c)
(list (+ a c) (+ b c)))
(lambda (d e)
(+ d e)))
(list 1 2 3))
then you'd need apply rather than funcall in the definition of apply-funcs.
Depending on the situation, you might also take the macro route;
(defmacro ->> (value &body functions)
(reduce
(lambda (memo fn) `(funcall ,fn ,memo))
functions :initial-value value))
which will do essentially the same thing.
CL-USER> (->> 6
(lambda (n) (+ 3 n))
(lambda (n) (- n 2))
(lambda (n) (* 2 n)))
14
CL-USER> (macroexpand
'(->> 6
(lambda (n) (+ 3 n))
(lambda (n) (- n 2))
(lambda (n) (* 2 n))))
(FUNCALL (LAMBDA (N) (* 2 N))
(FUNCALL (LAMBDA (N) (- N 2))
(FUNCALL (LAMBDA (N) (+ 3 N)) 6)))
T
(defun apply-funcs (functions value)
(loop for f in functions
for result = (funcall f value) then (funcall f result)
finally (return result)))
From the Alexandria library comes the compose (and multiple-value-compose) function, including a compiler macro for compose. What you're describing seems analogous to
(funcall (alexandria:compose #'h #'g #'f) x)
such that
(defun apply-funcs (functions value)
(funcall (apply #'compose (reverse functions)) value))
would do what you intend — although I suspect that calling compose directly might be more effective for your purposes, depending on the context.
The library functions are:
(defun compose (function &rest more-functions)
"Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies its
arguments to to each in turn, starting from the rightmost of MORE-FUNCTIONS,
and then calling the next one with the primary value of the last."
(declare (optimize (speed 3) (safety 1) (debug 1)))
(reduce (lambda (f g)
(let ((f (ensure-function f))
(g (ensure-function g)))
(lambda (&rest arguments)
(declare (dynamic-extent arguments))
(funcall f (apply g arguments)))))
more-functions
:initial-value function))
(define-compiler-macro compose (function &rest more-functions)
(labels ((compose-1 (funs)
(if (cdr funs)
`(funcall ,(car funs) ,(compose-1 (cdr funs)))
`(apply ,(car funs) arguments))))
(let* ((args (cons function more-functions))
(funs (make-gensym-list (length args) "COMPOSE")))
`(let ,(loop for f in funs for arg in args
collect `(,f (ensure-function ,arg)))
(declare (optimize (speed 3) (safety 1) (debug 1)))
(lambda (&rest arguments)
(declare (dynamic-extent arguments))
,(compose-1 funs))))))
Basicly,what I want to do is this:
I have a function square(x) (define (square x) (* x x))(f(x)=x*x),and another function mul_two (define (mul_two x) (* 2 x))(g(x)=2*x), I want to construct a new function based on the above two functions, what the new function does is this: 2*(x*x)(p(x)=g(f(x))), how can I write this new function in scheme? Although its a pretty straight thing in mathmatical form I'm totally stuck on this .
The usual way to do what you're asking is by using compose, which according to the linked documentation:
Returns a procedure that composes the given functions, applying the last proc first and the first proc last.
Notice that compose is quite powerful, it allows us to pass an arbitrary number of functions that consume and produce any number of values. But your example is simple to implement:
(define (square x) ; f(x)
(* x x))
(define (mul_two x) ; g(x)
(* 2 x))
(define p ; g(f(x))
(compose mul_two square))
(p 3) ; same as (mul_two (square 3))
=> 18
If for some reason your Scheme interpreter doesn't come with a built-in compose, it's easy to code one - and if I understood correctly the comments to the other answer, you want to use currying. Let's write one for the simple case where only a single value is produced/consumed by each function, and only two functions are composed:
(define my-compose ; curried and simplified version of `compose`
(lambda (g)
(lambda (f)
(lambda (x)
(g (f x))))))
(define p ; g(f(x))
((my-compose mul_two) square))
(p 3) ; same as (mul_two (square 3))
=> 18
(define (new_fun x) (mul_two (square x)))
EDIT:
(define (square x) (* x x))
(define (mul_two x) (* 2 x))
(define (new_fun fun1 fun2) (lambda (x) (fun2 (fun1 x))))
((new_fun square mul_two) 10)
And you will get 200. (10 * 10 * 2)
Also, you can implement a general purpose my-compose function just as the compose in racket:
(define (my-compose . funcs)
(let compose2
((func-list (cdr funcs))
(func (lambda args (apply (car funcs) args))))
(if (null? func-list)
func
(compose2
(cdr func-list)
(lambda args (func (apply (car func-list) args)))))))
And you can obtain new-fun by:
(define new-fun (my-compose mul_two square))
In #!racket (the language) you have compose such that:
(define double-square (compose double square))
Which is the same as doing this:
(define (double-square . args)
(double (apply square args)))
If you want to use Scheme (the standard) you can roll your own:
#!r6rs
(import (rnrs))
(define (compose . funs)
(let* ((funs-rev (reverse funs))
(first-fun (car funs-rev))
(chain (cdr funs-rev)))
(lambda args
(fold-left (lambda (arg fun)
(fun arg))
(apply first-fun args)
chain))))
(define add-square (compose (lambda (x) (* x x)) +))
(add-square 2 3 4) ; ==> 81