why define-syntax of or in scheme need consider three conditions? - functional-programming

I'm reading the scheme programming language, in chapter 3, the book use define-syntax to define or and and procedure, and it says the following definition of or is incorrect:
(define-syntax or ; incorrect!
(syntax-rules ()
[(_) #f]
[(_ e1 e2 ...)
(let ([t e1])
(if t t (or e2 ...)))]))
And the correct definition is:
(define-syntax or
(syntax-rules ()
[(_) #f]
[(_ e) e]
[(_ e1 e2 e3 ...)
(let ([t e1])
(if t t (or e2 e3 ...)))]))
Why the correct definition need three conditions? I run many tests, the two definitions produce the same results. How can tell me why the first definition is wrong?

Let's consider the hint from the book.
First we define our own version of or:
(define-syntax my-or ; incorrect!
(syntax-rules ()
[(_) #f]
[(_ e1 e2 ...)
(let ([t e1])
(if t t (my-or e2 ...)))]))
Then we look at the expression in the hint.
(letrec ([even?
(lambda (x)
(my-or (= x 0)
(odd? (- x 1))))]
[odd?
(lambda (x)
(and (not (= x 0))
(even? (- x 1))))])
(list (even? 20) (odd? 20)))
Let's look at the expansion (I edited the full expansion a little):
(letrec ([even? (lambda (x)
(let ([t (= x 0)])
(if t t (let ([t (odd? (- x 1))])
(if t t #f)))))]
[odd? (lambda (x) (if (not (= x 0)) (even? (- x 1)) #f))])
(list (even? 20) (odd? 20)))
The problem here is that the call to odd? in (let ([t (odd? (- x 1))]) ...)
is not in tail position. For each loop the let expression will allocate a new variable (on the stack or elsewhere) an eventually we have a memory problem.
In short: The semantics of or is that in (or e1 ... en) the last expression en is in tail position. If we use the simple version of the my-or macro, then
(my-or e1)
expands into
(let ([t e1])
(if t t #f))]))
and the expression e1 is not in tail position in the output.

It will works too
(define-syntax foo
(syntax-rules ()
((_) #f)
((_ e) e)
((_ e1 e2 ...)
(let ((t e1))
(if t t (foo e2 ...))))))

Related

is it possible to create an anonymous recursive function in racket

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.

How to make recursion using only lambdas in Racket?

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.

How to plot a matrix as an image in racket?

I would like to do something similar to matplotlib.pyplot.matshow with racket. I understand this is a trivial question and maybe I'm just being stupid, but I was unsuccessful after reading the Racket plotting documentation.
An example matrix that would be translated into the image of a circle:
#lang typed/racket
(require math/array)
(require plot)
(: sq (-> Integer Integer))
(define (sq [v : Integer])
(* v v))
(: make-2d-matrix (-> Integer Integer (Array Boolean)))
(define (make-2d-matrix [s : Integer] [r : Integer])
(let ([center : Integer (exact-round (/ s 2))])
(let ([a (indexes-array ((inst vector Integer) s s))])
(let ([b (inline-array-map (λ ([i : (Vectorof Index)])
(+
(sq (- (vector-ref i 0) center))
(sq (- (vector-ref i 1) center))))
a)])
(array<= b (array (sq r)))
))))
(array-map (λ ([i : Boolean]) (if (eq? i #f) 0 1)) (make-2d-matrix 20 6))
Can someone give me a hint?
Totally not a dumb question. This is one of those areas where it's hard to compete with an army of python library programmers. Here's how I'd do it in Racket:
#lang racket
(require 2htdp/image
math/array)
;; a 10x10 array
(define a
(build-array #(10 10)
(λ (e)
(match e
[(vector x y)
(cond [(= x y) x]
[else 0])]))))
;; map a value to a color
(define (cmap v)
(color (floor (* 255 (/ v 10)))
0
(floor (* 255 (- 1 (/ v 10))))))
(apply
above
(for/list ([y (in-range 10)])
(apply
beside
(for/list ([x (in-range 10)])
(rectangle 10 10 'solid (cmap (array-ref a (vector x y))))))))
Depending on you situation, you might be interested in flomaps:
http://docs.racket-lang.org/images/flomap_title.html?q=flbitmap
I'm not sure exactly what you want to plot. The plot library is designed around plotting functions, but I don't know what function you want to express.
Here are two ways of plotting a matrix:
(plot (points (cast (array->vector* m) (Vectorof (Vectorof Real)))
(plot3d (points3d (cast (array->vector* m) (Vectorof (Vectorof Real)))
The cast is needed because the type of array->vector* is not specific enough.

Lexical versus dynamic scope, let form, declare form

Dynamic versus lexical scope.
; One expects lexical scope.
(let (( a '(a)))
(defun func1 (x)
(setq a (cons x (cons (func2 x) a))))
(defun func2 (y)
(setq a (cons y a))))
(func1 'b)
=> (B (B A) B A)
Doing it lexically, one would expect
the following.
Substitute (a) for the a in func2.
func2 is called with x, i.e. the value b.
func2 also attaches the value of a with (a).
So the (cons y a) evaluates to (b a).
(setq a (cons y a))) is (b a).
So func1 will cons (b a) with (a).
x is then consed (b (b a) a)).
End result (b (b a) a)? Is this a contradiction?
Let us try a dynamical version.
; dynamic scope
(defparameter a '(a))
(defun func1 (x)
(setq a (cons x (cons (func2 x) a))))
(defun func2 (y)
(setq a (cons y a)))
(func1 'b)
=>(B (B A) B A)
This works as is to be expected but is the same as in lexical scope?
But the following is not accepted at all.
; This won't work.
(let (( a '(a)))
(defun func1 (x)
(declare (special a))
(setq a (cons x (cons (func2 x) a))))
(defun func2 (y)
(declare (special a))
(setq a (cons y a))))
(func1 'b)
Error: Attempt to take the value of the unbound variable `A'.
What is going on?
Thanks for the keen eyes. This example is from a 31 years old printed Lisp textbook straight out of the chapter "dynamic versus lexical scoping". The explanation comes also straight out of that book. I guess that the lexical scoping was not checked, because the authors explicitly warn the readers that lexical scoping was not done in Lisp. I am happy that this is solved. I stared some time on it, without understanding what was really going on. It seemed to be an odd contradiction.

How do I apply a list of functions to a single variable?

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))))))

Resources