I have just started studying Racket/Scheme continuations and found a helpful resource - Matt Mights page. I understood everything till the nondeterministic Amb example. Can anyone explain me how continuations work in this example? Currently looks like black magic for me.
; current-continuation : -> continuation
(define (current-continuation)
(call-with-current-continuation
(lambda (cc)
(cc cc))))
; fail-stack : list[continuation]
(define fail-stack '())
; fail : -> ...
(define (fail)
(if (not (pair? fail-stack))
(error "back-tracking stack exhausted!")
(begin
(let ((back-track-point (car fail-stack)))
(set! fail-stack (cdr fail-stack))
(back-track-point back-track-point)))))
; amb : list[a] -> a
(define (amb choices)
(let ((cc (current-continuation)))
(cond
((null? choices) (fail))
((pair? choices)
(let ((choice (car choices)))
(set! choices (cdr choices))
(set! fail-stack (cons cc fail-stack))
choice)))))
; (assert condition) will cause
; condition to be true, and if there
; is no way to make it true, then
; it signals and error in the program.
(define (assert condition)
(if (not condition)
(fail)
#t))
; The following prints (4 3 5)
(let ((a (amb (list 1 2 3 4 5 6 7)))
(b (amb (list 1 2 3 4 5 6 7)))
(c (amb (list 1 2 3 4 5 6 7))))
; We're looking for dimensions of a legal right
; triangle using the Pythagorean theorem:
(assert (= (* c c) (+ (* a a) (* b b))))
(display (list a b c))
(newline)
; And, we want the second side to be the shorter one:
(assert (< b a))
; Print out the answer:
(display (list a b c))
(newline))
Oh boy...this code looks like its trying to use continuations to do proper error handling. Which is...technically...possible. But honestly, since you said you were doing this in Racket and not just scheme, it would be much better to just use Racket's exception handling mechanism directly.
But I will break down the pieces of the program.
First, the general algorithm is:
Assume a, b, and c are the first item in their respective lists.
If when running code, you reach an assert that fails, go back in time and assume that c is actually the next thing in the list.
If you've gone back in time enough to the point where you have run out of c possibilities, try the second item for b. Repeat until you run out of possibilities for b, then do the same for a.
Basically, its just a backtracking search algorithm that uses continuations in an attempt to look fancy.
The function
(define (current-continuation)
(call-with-current-continuation
(lambda (cc)
(cc cc))))
Just grabs the current continuation. Basically you can think of it as a snapshot in time, which you can access by calling it as a function. So you can do:
(let ([cc (current-continuation)])
...)
Now in that block calling cc will rewind the computation to that point, replacing cc with what you passed into it. So if you were to, say, pass cc into it, like:
(let ([cc (current-continuation)])
(cc cc))
your program would loop.
(define fail-stack '())
; fail : -> ...
(define (fail)
(if (not (pair? fail-stack))
(error "back-tracking stack exhausted!")
(begin
(let ((back-track-point (car fail-stack)))
(set! fail-stack (cdr fail-stack))
(back-track-point back-track-point)))))
; (assert condition) will cause
; condition to be true, and if there
; is no way to make it true, then
; it signals and error in the program.
(define (assert condition)
(if (not condition)
(fail)
#t))
This just keeps a stack of continuations to call when an assert fails.
; amb : list[a] -> a
(define (amb choices)
(let ((cc (current-continuation)))
(cond
((null? choices) (fail))
((pair? choices)
(let ((choice (car choices)))
(set! choices (cdr choices))
(set! fail-stack (cons cc fail-stack))
choice)))))
This sets up the space that can be explored.
; The following prints (4 3 5)
(let ((a (amb (list 1 2 3 4 5 6 7)))
(b (amb (list 1 2 3 4 5 6 7)))
(c (amb (list 1 2 3 4 5 6 7))))
; We're looking for dimensions of a legal right
; triangle using the Pythagorean theorem:
(assert (= (* c c) (+ (* a a) (* b b))))
(display (list a b c))
(newline)
; And, we want the second side to be the shorter one:
(assert (< b a))
; Print out the answer:
(display (list a b c))
(newline))
And this does the actual search, and prints out the results.
Related
I am trying to combine a list of pairs in scheme to get all possible combinations. For example:
((1 2) (3 4) (5 6)) --> ((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
I've been able to solve it (I think) using a "take the first and prepend it to the cdr of the procedure" with the following:
(define (combine-pair-with-list-of-pairs P Lp)
(apply append
(map (lambda (num)
(map (lambda (pair)
(cons num pair)) Lp)) P)))
(define (comb-N Lp)
(if (null? Lp)
'(())
(combine-pair-with-list-of-pairs (car Lp) (comb-N (cdr Lp)))))
(comb-N '((1 2)(3 4)(5 6)))
; ((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
However, I've been having trouble figuring out how I can use a procedure that only takes two and having a wrapper around it to be able to define comb-N by calling that function. Here it is:
(define (combinations L1 L2)
(apply append
(map (lambda (L1_item)
(map (lambda (L2_item)
(list L1_item L2_item))
L2))
L1)))
(combinations '(1) '(1 2 3))
; ((1 1) (1 2) (1 3))
I suppose the difficulty with calling this function is it expects two lists, and the recursive call is expecting a list of lists as the second argument. How could I call this combinations function to define comb-N?
difficulty? recursion? where?
You can write combinations using delimited continuations. Here we represent an ambiguous computation by writing amb. The expression bounded by reset will run once for each argument supplied to amb -
(define (amb . lst)
(shift k (append-map k lst)))
(reset
(list (list (amb 'a 'b) (amb 1 2 3))))
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3))
how it works
The expression is evaluated through the first amb where the continuation is captured to k -
k := (list (list ... (amb 1 2 3)))
Where applying k will supply its argument to the "hole" left by amb's call to shift, represented by ... above. We can effectively think of k in terms of a lambda -
k := (lambda (x) (list (list x (amb 1 2 3)))
amb returns an append-map expression -
(append-map k '(a b))
Where append-map will apply k to each element of the input list, '(a b), and append the results. This effectively translates to -
(append
(k 'a)
(k 'b))
Next expand the continuation, k, in place -
(append
(list (list 'a (amb 1 2 3))) ; <-
(list (list 'b (amb 1 2 3)))) ; <-
Continuing with the evaluation, we evaluate the next amb. The pattern is continued. amb's call to shift captures the current continuation to k, but this time the continuation has evolved a bit -
k := (list (list 'a ...))
Again, we can think of k in terms of lambda -
k := (lambda (x) (list (list 'a x)))
And amb returns an append-map expression -
(append
(append-map k '(1 2 3)) ; <-
(list (list 'b ...)))
We can continue working like this to resolve the entire computation. append-map applies k to each element of the input and appends the results, effectively translating to -
(append
(append (k 1) (k 2) (k 3)) ; <-
(list (list 'b ...)))
Expand the k in place -
(append
(append
(list (list 'a 1)) ; <-
(list (list 'a 2)) ; <-
(list (list 'a 3))) ; <-
(list (list 'b (amb 1 2 3))))
We can really start to see where this is going now. We can simplify the above expression to -
(append
'((a 1) (a 2) (a 3)) ; <-
(list (list 'b (amb 1 2 3))))
Evaluation now continues to the final amb expression. We will follow the pattern one more time. Here amb's call to shift captures the current continuation as k -
k := (list (list 'b ...))
In lambda terms, we think of k as -
k := (lambda (x) (list (list 'b x)))
amb returns an append-map expression -
(append
'((a 1) (a 2) (a 3))
(append-map k '(1 2 3))) ; <-
append-map applies k to each element and appends the results. This translates to -
(append
'((a 1) (a 2) (a 3))
(append (k 1) (k 2) (k 3))) ; <-
Expand k in place -
(append
'((a 1) (a 2) (a 3))
(append
(list (list 'b 1)) ; <-
(list (list 'b 2)) ; <-
(list (list 'b 3)))) ; <-
This simplifies to -
(append
'((a 1) (a 2) (a 3))
'((b 1) (b 2) (b 3))) ; <-
And finally we can compute the outermost append, producing the output -
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3))
generalizing a procedure
Above we used fixed inputs, '(a b) and '(1 2 3). We could make a generic combinations procedure which applies amb to its input arguments -
(define (combinations a b)
(reset
(list (list (apply amb a) (apply amb b)))))
(combinations '(a b) '(1 2 3))
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3))
Now we can easily expand this idea to accept any number of input lists. We write a variadic combinations procedure by taking a list of lists and map over it, applying amb to each -
(define (combinations . lsts)
(reset
(list (map (lambda (each) (apply amb each)) lsts))))
(combinations '(1 2) '(3 4) '(5 6))
((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
Any number of lists of any length can be used -
(combinations
'(common rare)
'(air ground)
'(electric ice bug)
'(monster))
((common air electric monster)
(common air ice monster)
(common air bug monster)
(common ground electric monster)
(common ground ice monster)
(common ground bug monster)
(rare air electric monster)
(rare air ice monster)
(rare air bug monster)
(rare ground electric monster)
(rare ground ice monster)
(rare ground bug monster))
related reading
In Scheme, we can use Olivier Danvy's original implementation of shift/reset. In Racket, they are supplied via racket/control
(define-syntax reset
(syntax-rules ()
((_ ?e) (reset-thunk (lambda () ?e)))))
(define-syntax shift
(syntax-rules ()
((_ ?k ?e) (call/ct (lambda (?k) ?e)))))
(define *meta-continuation*
(lambda (v)
(error "You forgot the top-level reset...")))
(define abort
(lambda (v)
(*meta-continuation* v)))
(define reset-thunk
(lambda (t)
(let ((mc *meta-continuation*))
(call-with-current-continuation
(lambda (k)
(begin
(set! *meta-continuation* (lambda (v)
(begin
(set! *meta-continuation* mc)
(k v))))
(abort (t))))))))
(define call/ct
(lambda (f)
(call-with-current-continuation
(lambda (k)
(abort (f (lambda (v)
(reset (k v)))))))))
For more insight on the use of append-map and amb, see this answer to your another one of your questions.
See also the Compoasable Continuations Tutorial on the Scheme Wiki.
remarks
I really struggled with functional style at first. I cut my teeth on imperative style and it took me some time to see recursion as the "natural" way of thinking to solve problems in a functional way. However I offer this post in hopes to provoke you to reach for even higher orders of thinking and reasoning. Recursion is the topic I write about most on this site but I'm here saying that sometimes even more creative, imaginative, declarative ways exist to express your programs.
First-class continuations can turn your program inside-out, allowing you to write a program which manipulates, consumes, and multiplies itself. It's a sophisticated level of control that's part of the Scheme spec but only fully supported in a few other languages. Like recursion, continuations are a tough nut to crack, but once you "see", you wish you would've learned them earlier.
As suggested in the comments you can use recursion, specifically, right fold:
(define (flatmap foo xs)
(apply append
(map foo xs)))
(define (flatmapOn xs foo)
(flatmap foo xs))
(define (mapOn xs foo)
(map foo xs))
(define (combs L1 L2) ; your "combinations", shorter name
(flatmapOn L1 (lambda (L1_item)
(mapOn L2 (lambda (L2_item) ; changed this:
(cons L1_item L2_item)))))) ; cons NB!
(display
(combs '(1 2)
(combs '(3 4)
(combs '(5 6) '( () )))))
; returns:
; ((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
So you see, the list that you used there wasn't quite right, I changed it back to cons (and thus it becomes fully the same as combine-pair-with-list-of-pairs). That way it becomes extensible: (list 3 (list 2 1)) isn't nice but (cons 3 (cons 2 (cons 1 '()))) is nicer.
With list it can't be used as you wished: such function receives lists of elements, and produces lists of lists of elements. This kind of output can't be used as the expected kind of input in another invocation of that function -- it would produce different kind of results. To build many by combining only two each time, that combination must produce the same kind of output as the two inputs. It's like +, with numbers. So either stay with the cons, or change the combination function completely.
As to my remark about right fold: that's the structure of the nested calls to combs in my example above. It can be used to define this function as
(define (sequence lists)
(foldr
(lambda (list r) ; r is the recursive result
(combs list r))
'(()) ; using `()` as the base
lists))
Yes, the proper name of this function is sequence (well, it's the one used in Haskell).
I'm working on this project in Scheme and these errors on these three particular methods have me very stuck.
Method #1:
; Returns the roots of the quadratic formula, given
; ax^2+bx+c=0. Return only real roots. The list will
; have 0, 1, or 2 roots. The list of roots should be
; sorted in ascending order.
; a is guaranteed to be non-zero.
; Use the quadratic formula to solve this.
; (quadratic 1.0 0.0 0.0) --> (0.0)
; (quadratic 1.0 3.0 -4.0) --> (-4.0 1.0)
(define (quadratic a b c)
(if
(REAL? (sqrt(- (* b b) (* (* 4 a) c))))
((let ((X (/ (+ (* b -1) (sqrt(- (* b b) (* (* 4 a) c)))) (* 2 a)))
(Y (/ (- (* b -1) (sqrt(- (* b b) (* (* 4 a) c)))) (* 2 a))))
(cond
((< X Y) (CONS X (CONS Y '())))
((> X Y) (CONS Y (CONS X '())))
((= X Y) (CONS X '()))
)))#f)
Error:
assertion-violation: attempt to call a non-procedure [tail-call]
('(0.0) '())
1>
assertion-violation: attempt to call a non-procedure [tail-call]
('(-4.0 1.0) '())
I'm not sure what it is trying to call. (0.0) and (-4.0 1.0) is my expected output so I don't know what it is trying to do.
Method #2:
;Returns the list of atoms that appear anywhere in the list,
;including sublists
; (flatten '(1 2 3) --> (1 2 3)
; (flatten '(a (b c) ((d e) f))) --> (a b c d e f)
(define (flatten lst)
(cond
((NULL? lst) '())
((LIST? lst) (APPEND (CAR lst) (flatten(CDR lst))))
(ELSE (APPEND lst (flatten(CDR lst))))
)
)
Error: assertion-violation: argument of wrong type [car]
(car 3)
3>
assertion-violation: argument of wrong type [car]
(car 'a)
I'm not sure why this is happening, when I'm checking if it is a list before I append anything.
Method #3
; Returns the value that results from:
; item1 OP item2 OP .... itemN, evaluated from left to right:
; ((item1 OP item2) OP item3) OP ...
; You may assume the list is a flat list that has at least one element
; OP - the operation to be performed
; (accumulate '(1 2 3 4) (lambda (x y) (+ x y))) --> 10
; (accumulate '(1 2 3 4) (lambda (x y) (* x y))) --> 24
; (accumulate '(1) (lambda (x y) (+ x y))) --> 1
(define (accumulate lst OP)
(define f (eval OP (interaction-environment)))
(cond
((NULL? lst) '())
((NULL? (CDR lst)) (CAR lst))
(ELSE (accumulate(CONS (f (CAR lst) (CADR lst)) (CDDR lst)) OP))
)
)
Error:
syntax-violation: invalid expression [expand]
#{procedure 8664}
5>
syntax-violation: invalid expression [expand]
#{procedure 8668}
6>
syntax-violation: invalid expression [expand]
#{procedure 8672}
7>
syntax-violation: invalid expression [expand]
#{procedure 1325 (expt in scheme-level-1)}
This one I have no idea what this means, what is expand?
Any help would be greatly appreciated
code has (let () ...) which clearly evaluates to list? so the extra parentheses seems odd. ((let () +) 1 2) ; ==> 3 works because the let evaluates to a procedure, but if you try ((cons 1 '()) 1 2) you should get an error saying something like application: (1) is not a procedure since (1) isn't a procedure. Also know that case insensitivity is deprecated so CONS and REAL? are not future proof.
append concatenates lists. They have to be lists. In the else you know since lst is not list? that lst cannot be an argument of append. cons might be what you are looking for. Since lists are abstraction magic in Scheme I urge you to get comfortable with pairs. When I read (1 2 3) I see (1 . (2 . (3 . ()))) or perhaps (cons 1 (cons 2 (cons 3 '()))) and you should too.
eval is totally inappropriate in this code. If you pass (lambda (x y) (+ x y)) which evaluates to a procedure to OP you can do (OP 1 2). Use OP directly.
I am trying to write by myself the cons function in scheme. I have written this code:
(define (car. z)
(z (lambda (p q) p)))
and I am trying to run :
(car. '(1 2 3))
I expect to get the number 1, but it does not work properly.
When you implement language data structures you need to supply constructors and accessors that conform to the contract:
(car (cons 1 2)) ; ==> 1
(cdr (cons 1 2)) ; ==> 2
(pair? (cons 1 2)) ; ==> 2
Here is an example:
(define (cons a d)
(vector a d))
(define (car p)
(vector-ref p 0))
(define (cdr p)
(vector-ref p 1))
Now if you make an implementation you would implement read to be conformant to this way of doing pairs so that '(1 2 3) would create the correct data structure the simple rules above is still the same.
From looking at car I imagine cons looks like this:
(define (cons a d)
(lambda (p) (p a d)))
It works with closures. Now A stack machine implementation of Scheme would analyze the code for free variables living passed their scope and thus create them as boxes. Closures containing a, and d aren't much different than vectors.
I urge you to implement a minimalistic Scheme interpreter. First in Scheme since you can use the host language, then a different than a lisp language. You can even do it in an esoteric language, but it is very time consuming.
Sylwester's answer is great. Here's another possible implementation of null, null?, cons, car, cdr -
(define null 'null)
(define (null? xs)
(eq? null xs))
(define (cons a b)
(define (dispatch message)
(match message
('car a)
('cdr b)
(_ (error 'cons "unsupported message" message))
dispatch)
(define (car xs)
(if (null? xs)
(error 'car "cannot call car on an empty pair")
(xs 'car)))
(define (cdr xs)
(if (null? xs)
(error 'cdr "cannot call cdr on an empty pair")
(xs 'cdr)))
It works like this -
(define xs (cons 'a (cons 'b (cons 'c null))))
(printf "~a -> ~a -> ~a\n"
(car xs)
(car (cdr xs))
(car (cdr (cdr xs))))
;; a -> b -> c
It raises errors in these scenarios -
(cdr null)
; car: cannot call car on an empty pair
(cdr null)
; cdr: cannot call cdr on an empty pair
((cons 'a 'b) 'foo)
;; cons: unsupported dispatch: foo
define/match adds a little sugar, if you like sweet things -
(define (cons a b)
(define/match (dispatch msg)
(('car) a)
(('cdr) b)
(('pair?) #t)
((_) (error 'cons "unsupported dispatch: ~a" msg)))
dispatch)
((cons 1 2) 'car) ;; 1
((cons 1 2) 'cdr) ;; 2
((cons 1 2) 'pair?) ;; #t
((cons 1 2) 'foo) ;; cons: unsupported dispatch: foo
You are given a list of strings.
Generate a procedure such that applying this procedure to such a list
would result in a list of the lengths of each of the strings in the
input.
Use map, filter, or fold-right.
(lengths (list "This" "is" "not" "fun")) => (4 2 3 3)
(define lengths (lambda (lst) your_code_here))
I got stuck in the following code and I do not understand how can I use filter.
(define lengths
(lambda (lst)
(if (null? lst)
nil
(fold-right list (string-length (car lst)) (cdr lst)))))
This seems like a work for map, you just have to pass the right procedure as a parameter:
(define (lengths lst)
(map string-length lst))
As you should know, map applies a procedure to each of the elements in the input list, returning a new list collecting the results. If we're interested in building a list with the lengths of strings, then we call string-length on each element. The procedure pretty much writes itself!
A word of advice: read the documentation of the procedures you're being asked to use, the code you're writing is overly complicated. This was clearly not a job for filter, although fold-right could have been used, too. Just remember: let the higher-order procedure take care of the iteration, you don't have to do it explicitly:
(define (lengths lst)
(fold-right (lambda (x a)
(cons (string-length x) a))
'()
lst))
This looks like homework so I'll only give you pointers:
map takes a procedure and applies to to every element of a list. Thus
(define (is-strings lst)
(map string? lst))
(is-strings '("hello" 5 sym "89")) ; (#t #f #f #t)
(define (add-two lst)
(map (lambda (x) (+ x 2)) lst))
(add-two '(3 4 5 6)) ; ==> (5 6 7 8)
filter takes procedure that acts as a predicate. If #f the element is omitted, else the element is in the resulting list.
(define (filter-strings lst)
(filter string? lst))
(filter-strings '(3 5 "hey" test "you")) ; ==> ("hey" "you")
fold-right takes an initial value and a procedure that takes an accumulated value and a element and supposed to generate a new value:
(fold-right + 0 '(3 4 5 6)) ; ==> 18, since its (+ 3 (+ 4 (+ 5 (+ 6 0))))
(fold-right cons '() '(a b c d)) ; ==> (a b c d) since its (cons a (cons b (cons c (cons d '()))))
(fold-right - 0 '(1 2 3)) ; ==> -2 since its (- 1 (- 2 (- 3 0)))
(fold-right (lambda (e1 acc) (if (<= acc e1) acc e1)) +Inf.0 '(7 6 2 3)) ; ==> 2
fold-right has a left handed brother that is iterative and faster, though for list processing it would reverse the order after processing..
(fold-left (lambda (acc e1) (cons e1 acc)) '() '(1 2 3 4)) ; ==> (4 3 2 1)
i'm trying redefine the function "range" in Racket.
(define (my-range a b)
(if (> a b)
null
(cons a (my-range (+ 1 a) b))))
;; Test
(my-range 2 5)
;; -> (cons 2 (cons 3 (cons 4 (cons 5 empty))))
Now I want to extend my-range as follows:
(define (my-range a b step) ...)
e.g. (my-range 2 6 1) --> (list 2 3 4 5)
The first number is a and each successive element is generated by adding step to the previous element. The sequence stops before an element that would be greater or equal to b. How can I do this?
To reiterate, range already exists in the Racket library; if you don't have to redefine it, just use the one in the standard library.
From the comments I guess you already found the solution. For completeness' sake, here it is:
(define (my-range a b step)
(if (>= a b)
null
(cons a (my-range (+ step a) b step))))
In fact, this procedure is rather common and it can be expressed in several ways. As #dyoo has pointed, range is a standard procedure:
(define (my-range a b step)
(range a b step))
Also, in terms of build-list, another standard Racket procedure:
(define (my-range a b step)
(build-list (ceiling (/ (- b a) step))
(lambda (x) (+ a (* step x)))))
Or using streams:
(define (my-range a b step)
(stream->list (in-range a b step)))