I'm working with modifying a list in scheme and was wondering basically how mutability is usually done (or if it's done at all). Here is one example of "adding positions to a chess board".
; representing a chess position as (col, row), using 1-based indexing
(define (make-position col row) (cons col (list row)))
(define empty-board '())
(define (add-new-position existing-positions col row)
(append existing-positions (list (make-position col row))))
And using them:
(define B1 empty-board)
(set! B1 (add-new-position B1 1 2))
(set! B1 (add-new-position B1 2 4))
(display "B1=") (display B1) (newline)
; B1=((1 2) (2 4))
(define B2 empty-board)
(add-new-position B2 1 2)
(add-new-position B2 2 4)
(display "B2=") (display B2) (newline)
; B2=()
Is the above usually how mutability is handled (using set!)? Is that fine to do, or usually discouraged in scheme or other functional programming languages? And if it's discouraged, how would someone, for example, debug in the middle of "building a list" ?
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 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.
Going further for the scheme how do you sum numbers in a list when you have structures and list of lists now i want to replace all occurrences of atom a1 in SEXP with atom a2.
For example,
(replace (list (list 'a 'b) (list 1 3 )) 'a 'b) =>
(list (list 'b 'b) (list 1 3))
(replace (list (list 'a 'b) (list 1 3)) 1 2) =>
(list (list 'a 'b) (list 2 3))
;; An ATOM is one of:
;; -- Symbol
;; -- String
;; -- Number
(define-struct SEXP (ATOM SEXP))
;; An SEXP (S-expression) is one of:
;; -- empty
;; -- (cons ATOM SEXP)
;; -- (cons SEXP SEXP)
My code,
;; replace: Atom atom sexp -> sexp
(define (replace a1 a2 sexp)
(cond
[(empty? sexp) empty]
[(SEXP? sexp)
(cons (replace a1 a2 (first sexp)) (replace a1 a2 (rest sexp)))]
[else
(cond
[(or (symbol=? (first sexp) a1)
(string=? (first sexp) a1)
(= (first sexp) a1))
(cons a2 (replace a1 a2 (rest sexp)))]
[else (cons (first sexp) (replace a1 a2 (rest sexp)))])]))
for the part to determine if it is a1, do we need call a helper function we could do so in my way present here?
Also, since sexp is a list of lists and atom is flat,
(symbol=? (first sexp) a1)
might cause problem since scheme would expect a symbol but given (list xxxxxx)
How do you fix that problem as well?
The code can be simplified a great deal if we make sure that the equality comparison is performed only when we're sure that sexp is an atom, try this:
(define (replace a1 a2 sexp)
(cond
[(empty? sexp) empty]
[(SEXP? sexp) ; (define SEXP? pair?)
(cons (replace a1 a2 (first sexp))
(replace a1 a2 (rest sexp)))]
[(equal? sexp a1) a2]
[else sexp]))
The same comments to your previous question apply, though: you must be consistent, and if you're using SEXP structs then you must stick to using that struct's accessor procedures, instead of first, rest, etc. Also notice how we can use equal? for comparisons when we don't know beforehand the specific type of the elements. Test it like this, and notice the correct order of the parameters:
(replace 'a 'b (list (list 'a 'b) (list 1 3)))
=> '((b b) (1 3))
(replace 1 2 (list (list 'a 'b) (list 1 3)))
=> '((a b) (2 3))
This code is from SICP, 3.3.5 Propagation of Constraints. I can't seem to figure out why process-forget-value needs to call process-new-value as the final step.
The text says, "The reason for this last step is that one or more connectors may still have a value (that is, a connector may have had a value that was not originally set by the adder), and these values may need to be propagated back through the adder."
What is the simplest constraint network that can demonstrate why (process-new-value) is needed? Thanks!
(define (adder a1 a2 sum)
(define (process-new-value)
(cond ((and (has-value? a1) (has-value? a2))
(set-value! sum
(+ (get-value a1) (get-value a2))
me))
((and (has-value? a1) (has-value? sum))
(set-value! a2
(- (get-value sum) (get-value a1))
me))
((and (has-value? a2) (has-value? sum))
(set-value! a1
(- (get-value sum) (get-value a2))
me))))
(define (process-forget-value)
(forget-value! sum me)
(forget-value! a1 me)
(forget-value! a2 me)
(process-new-value)) ;;; * WHY * ???
(define (me request)
(cond ((eq? request 'I-have-a-value)
(process-new-value))
((eq? request 'I-lost-my-value)
(process-forget-value))
(else
(error "Unknown request -- ADDER" request))))
(connect a1 me)
(connect a2 me)
(connect sum me)
me)
This Is a test I have made removing process-new-value from the adder. You will see that the behavior is different.
(define c (make-connector))
(define a (make-connector))
(define b (make-connector))
(define d (make-connector))
(constant 10 a)
(constant 10 c)
(constant 10 d)
(define adder1 (adder a b c))
(define adder2 (adder a b d))
> (has-value? b)
#t
> (get-value b)
0
> (forget-value! b adder1)
'done
> (has-value? b)
#f
If you do this with the correct version.
> (has-value? b)
#t
The second time also. As they say, when adder1 tells b to forget its value. a and c being constants will still have a value, and the last process-new-value in adder2, will again set b to 0. This will also work if you use set-value! for a and c.
The following function from pg 150 of the Seasoned Schemer establishes whether two lists have the same identity (i.e. occupy the same memory) by mutating each list's cdr and then checking whether the change has affected both:
(define same?
(lambda (c1 c2)
(let ((t1 (cdr c1))
(t2 (cdr c2)))
(set-cdr! c1 1)
(set-cdr! c2 2)
(let ((v (= (cdr c1) (cdr c2))))
(set-cdr! c1 t1)
(set-cdr! c2 t2)
v))))
Now if I define a_list as follows:
(define a_list (list 'a 'b 'c 'd))
and evaluate
(same? a_list (cdr a_list))
the function returns #f, and the debugger (Dr. Racket) confirms that these two lists -- which ought to share most of their members since the second argument is a proper subset of the first -- do in fact have different copies of the same members. How is this possible?!
For a slight twist on this idea:
(set-cdr! (cddr a_list) a_list)
Now a_list is cyclical. If I test this function with same? it only registers #t when the two arguments are in phase, i.e. (same? a_list a_list) and (same? a_list (cdddr a_list)).
[EDIT The answer is at the bottom of the accepted post's comment chain]
The same? function does not check whether two lists share elements.
It checks whether two pairs (i.e. two cons cells) are the same.
In (define a_list (list 'a 'b 'c 'd)) you have 4 pairs.
In (same? a_list (cdr a_list)) you check whether the first
and second pair is the same pair, and since they aren't,
same? returns #f.
With respect to:
.. and the debugger (Dr. Racket) confirms that these two lists -- which
ought to share most of their members since the second argument is a
proper subset of the first -- do in fact have different copies of the
same members. How is this possible?!
Can you be more precise about how you check this in DrRacket?
The two lists a-list and (cdr a-list) do share members.
EDIT:
Suppose c1 and c2 are names for two different cons cells:
c1: (foo . bar) c2: (baz . qux)
Now we evaluate (set-cdr! c1 1) and get:
c1: (foo . 1) c2: (baz . qux)
Now we evaluate (set-cdr! c2 2) and get:
c1: (foo . 1) c2: (baz . 2)
Then we compare the cdrs with (= (cdr c1) (cdr c2)).
Since the cdrs are different, we get #f.
Conclusion: When the cons cells are different, same? returns #f.
Now suppose c1 and c2 are names for the same cons cell:
c1 = c2: (foo . bar)
Now we evaluate (set-cdr! c1 1) and get:
c1 = c2: (foo . 1)
Now we evaluate (set-cdr! c2 2) and get:
c1 = c2: (foo . 2)
Then we compare the cdrs with (= (cdr c1) (cdr c2)).
Since the cdrs are the same, we get #t.
Conclusion: When the cons cells are the same, same? returns #f.
EDIT 2
To check whether the cons cell c is one of the
cons cells of l use this:
(define (loop c l)
(cond
[(null? l) #f]
[(same? c l) #t]
[else (loop c (cdr l))]))