I have the following function to scale a (2-col) matrix:
(define (scale-matrix matrix scale)
(map (lambda (row)
(list (* scale (car row))
(* scale (cadr row))))
matrix))
(scale-matrix '((1 2) (3 4)) 3)
; ((3 6) (9 12))
However, I'm having a hard time converting it into an inline curried call. Here is where I am at so far:
(map
(lambda (row)
(lambda (scale)
(list (* scale (car row))
(* scale (cadr row)))))
'((1 2) (3 4)))
; (#<procedure:...esktop/sicp/021.scm:54:3> #<procedure:...esktop/sicp/021.scm:54:3>)
What would be the proper way to pass both the scale and matrix here? In other words, where to put the 3 ?
The closest I've gotten thus far is to sort of hardocde the 3 in there:
(map
(lambda (row)
((lambda (scale)
; 3 hardcoded, nil placeholder. How to actually 'call' with 3?
(list (* 3 (car row)) (* 3 (cadr row)))) nil))
'((1 2) (3 4)))
Or, is it required that I pass the scale as the first argument? It seems to work that way, though not sure if that's required (or even why that works!)
((lambda (scale)
(map (lambda (row)
(list (* scale (car row)) (* scale (cadr row))))
'((1 2) (3 4)))) 3)
; ((3 6) (9 12))
Your last attempt is correct: you'll have to extract the lambda used for scale outside the map call. You can't modify the innermost lambda, map expects a lambda with one argument, you can't pass a nested lambda there. So if you want to curry the scale there's no option but:
((lambda (scale)
(map (lambda (row)
(list (* scale (car row))
(* scale (cadr row))))
'((1 2) (3 4))))
3)
=> '((3 6) (9 12))
As to why it works, it's like any other anonymous lambda call. Let's see a simpler example, this:
(define (add1 n)
(+ 1 n))
(add1 41)
When evaluated is equivalent to this:
((lambda (n)
(+ 1 n))
41)
Incidentally, the above is also how a let is expanded and evaluated:
(let ((n 41))
(+ 1 n))
So you could also inline the code as shown below; but why do you want to curry it, anyway? the original code with the procedure is just right.
(let ((scale 3))
(map (lambda (row)
(list (* scale (car row))
(* scale (cadr row))))
'((1 2) (3 4))))
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 trying to find the various combinations that can be made with a list of N pairs in scheme. Here is where I'm at thus far:
(define (pair-combinations list-of-pairs)
(if (null? list-of-pairs)
nil
(let ((first (caar list-of-pairs))
(second (cadar list-of-pairs))
(rest (pair-combinations (cdr list-of-pairs))))
(append
(list (cons first rest))
(list (cons second rest))
))))
Now, I'm not sure if the logic is correct, but what I notice immediately is the telescoping of parentheticals. For example:
(define p1 '( (1 2) (3 4) (5 6) ))
(pair-combinations p1)
((1 (3 (5) (6)) (4 (5) (6))) (2 (3 (5) (6)) (4 (5) (6))))
Obviously this is from the repetition of the list (... within the append calls, so the result looks something like (list 1 (list 2 (list 3 .... Is there a way to do something like the above in a single function? If so, where am I going wrong, and how would it be properly done?
The answer that I'm looking to get would be:
((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
That is, the possible ways to choose one element from N pairs.
Here is one way to think about this problem. If the input is the empty list, then the result is (). If the input is a list containing a single list, then the result is just the result of mapping list over that list, i.e., (combinations '((1 2 3))) --> ((1) (2) (3)).
Otherwise the result can be formed by taking the first list in the input, and prepending each item from that list to all of the combinations found for the rest of the lists in the input. That is, (combinations '((1 2) (3 4))) can be found by prepending each element of (1 2) to each of the combinations in (combinations '((3 4))), which are ((3) (4)).
It seems natural to express this in two procedures. First, a combinations procedure:
(define (combinations xss)
(cond ((null? xss) '())
((null? (cdr xss))
(map list (car xss)))
(else
(prepend-each (car xss)
(combinations (cdr xss))))))
Now a prepend-each procedure is needed:
(define (prepend-each xs yss)
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
yss))
xs)))
Here the procedure prepend-each takes a list xs and a list of lists yss and returns the result of prepending each x in xs to the lists in yss. The inner map takes each list ys in yss and conses an x from xs onto it. Since the inner mapping produces a list of lists, and the outer mapping then produces a list of lists of lists, append is used to join the results before returning.
combinations.rkt> (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))
Now that a working approach has been found, this could be converted into a single procedure:
(define (combinations-2 xss)
(cond ((null? xss) '())
((null? (cdr xss))
(map list (car xss)))
(else
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
(combinations-2 (cdr xss))))
(car xss))))))
But, I would not do that since the first version in two procedures seems more clear.
It might be helpful to look just at the results of prepend-each with and without using append:
combinations.rkt> (prepend-each '(1 2) '((3 4) (5 6)))
'((1 3 4) (1 5 6) (2 3 4) (2 5 6))
Without using append:
(define (prepend-each-no-append xs yss)
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
yss))
xs))
combinations.rkt> (prepend-each-no-append '(1 2) '((3 4) (5 6)))
'(((1 3 4) (1 5 6)) ((2 3 4) (2 5 6)))
It can be seen that 1 is prepended to each list in ((3 4) (5 6)) to create a list of lists, and then 2 is prepended to each list in ((3 4) (5 6)) to create a list of lists. These results are contained in another list, since the 1 and 2 come from the outer mapping over (1 2). This is why append is used to join the results.
Some Final Refinements
Note that prepend-each returns an empty list when yss is empty, but that a list containing the elements of xs distributed among as many lists is returned when yss contains a single empty list:
combinations.rkt> (prepend-each '(1 2 3) '(()))
'((1) (2) (3))
This is the same result that we want when the input to combinations contains a single list. We can modify combinations to have a single base case: when the input is '(), then the result is (()). This will allow prepend-each to do the work previously done by (map list (car xss)), making combinations a bit more concise; the prepend-each procedure is unchanged, but I include it below for completeness anyway:
(define (combinations xss)
(if (null? xss) '(())
(prepend-each (car xss)
(combinations (cdr xss)))))
(define (prepend-each xs yss)
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
yss))
xs)))
Having made combinations more concise, I might be tempted to go ahead and write this as one procedure, after all:
(define (combinations xss)
(if (null? xss) '(())
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
(combinations (cdr xss))))
(car xss)))))
I am new to racket and scheme and I am attempting to map the combination of a list to the plus funtion which take each combination of the list and add them together like follows:
;The returned combinations
((1 3) (2 3) (1 4) (2 4) (3 4) (1 5) (2 5) (3 5) (4 5) (1 6) (2 6) (3 6) (4 6) (5 6) (1 2) (2 2) (3 2) (4 2) (5 2) (6 2))
; expected results
((2) (5) (5).....)
Unfortunately I am receiving the contract violation expected error from the following code:
;list of numbers
(define l(list 1 2 3 4 5 6 2))
(define (plus l)
(+(car l)(cdr l)))
(map (plus(combinations l 2)))
There are a couple of additional issues with your code, besides the error pointed out by #DanD. This should fix them:
(define lst (list 1 2 3 4 5 6 2))
(define (plus lst)
(list (+ (car lst) (cadr lst))))
(map plus (combinations lst 2))
It's not a good idea to call a variable l, at first sight I thought it was a 1. Better call it lst (not list, please - that's a built-in procedure)
In the expected output, weren't you supposed to produce a list of lists? add a call to list to plus
You're not passing plus in the way that map expects it
Do notice the proper way to indent and format your code, it'll help you in finding bugs
You want (cadr l). Not (cdr l) in your plus function:
(define (plus l)
(+ (car l) (cadr l)))
Where x is (cons 1 (cons 2 '())):
(car x) => 1
(cdr x) => (cons 2 '())
(cadr x) == (car (cdr x)) => 2
(define (all-sublists buffer n)
(cond ((= n 0) n)
((all-sublists (append buffer (list (list n)) (map (lambda (x) (append (list n) x)) buffer)) (- n 1)))))
the result looks like this:
(all-sublists '((3) (2) (2 3) (1) (1 3) (1 2) (1 2 3)) 0)
when there is only one list around n:
(define (all-sublists buffer n)
(cond ((= n 0) n)
((all-sublists (append buffer (list n) (map (lambda (x) (append (list n) x)) buffer)) (- n 1)))))
the results get a dotted pair:
(all-sublists '(3 2 (2 . 3) 1 (1 . 3) (1 . 2) (1 2 . 3)) 0)
Is not that you have "to surround n with list twice to get the proper result", the truth is that there are several problems with your code, for starters: the last condition of a cond should start with an else, and you're using append incorrectly. If I understood correctly, you just want the powerset of a list:
(define (powerset aL)
(if (empty? aL)
'(())
(let ((rst (powerset (rest aL))))
(append (map (lambda (x) (cons (first aL) x))
rst)
rst))))
Like this:
(powerset '(1 2 3))
=> '((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) ())
Absract: The abstract problem is:
a list of values
a list of modifiers, things that act on the values to return new values
(for the example code I'm just multiplying the value by the modifier value)
the list of modifiers is not constrained to be the same size as the list of values.
apply the modifiers to the values, and get back any unused modifiers
Here's a version that that uses two separate functions: one to actually apply the modifiers, one to get the remaining modifiers
;; Return the modified list
(define (apply-mods vals mods)
(if (or (null? vals) (null? mods)) vals
(cons (* (car vals) (car mods)) (apply-mod (cdr vals) (cdr mods)))
)
)
;; trim the modifiers
(define (trim-mods vals mods)
(if (or (null? vals) (null? mods)) mods
(trim-mods (cdr vals) (cdr mods))
)
The idea is that after I apply the list of modifiers, (apply-mods vals mods) I may want to use the remaining
modifiers (trim-mods vals mods) in subsequent operations.
Currently, the best approach I've come up with is the two function approach, but it seems wasteful to iterate though the list twice.
Is there a clean way to return both the modified values, and the unused modifiers?
Concrete The concrete problem is:
my values are musical notes; each has a volume and a duration. Something like:
(vol: 1, dur: 1 beat)(vol: 1 dur: 2 beats)(vol: 1 dur: 1 beat)...
my modifiers are "changes to the volume", each has a volume change and a duration
(dvol: +1 dur: 4 beats)(dvol: -2 dur: 4 beats)...
as I recurse through the lists, I keep track of the net accumulated time to determine which modifier is in effect for a given note.
So in the real problem there is not the easy 1-1 mapping of modifiers to values, and thus I expect to run into situations where I'll apply a list of modifiers to a list of note that is shorter (in terms of duration) than the note list; I'll then want to apply the
remaining modifiers to the next note list (I plan on breaking the overall music into chunks).
Assuming these are the expected results:
> (apply-mods '((1 . 10)) '((1 . 4) (2 . 4) (3 . 4)))
'((2 . 4) (3 . 4) (4 . 2))
'((3 . 2))
> (apply-mods '((1 . 1) (1 . 2) (1 . 1)) '((+1 . 4) (-2 . 4)))
'((2 . 1) (2 . 2) (2 . 1))
'((-2 . 4))
this is a simple loop processing 2 lists in parallel:
(define (apply-mods vals mods)
(let loop ((vals vals) (mods mods) (res null))
(cond
((null? vals) (values (reverse res) mods))
((null? mods) (error "not enough mods"))
(else
(let ((val (car vals)) (mod (car mods)))
(let ((vol (car val)) (dur (cdr val)) (dvol (car mod)) (ddur (cdr mod)))
(cond
; case 1. duration of note = duration of mod => consume note and mod
((= dur ddur)
(loop (cdr vals)
(cdr mods)
(cons (cons (+ vol dvol) dur) res)))
; case 2. duration of note < duration of mod => consume note, push back shorter mod
((< dur ddur)
(loop (cdr vals)
(cons (cons dvol (- ddur dur)) (cdr mods))
(cons (cons (+ vol dvol) dur) res)))
; case 3. duration of note > duration of mod => push back part of note, consume mod
(else
(loop (cons (cons vol (- dur ddur)) (cdr vals))
(cdr mods)
(cons (cons (+ vol dvol) ddur) res))))))))))
It seems that your requirement is even simpler, and you probably only need to cover case 1, but I can only speculate while waiting for an example. In any case, you will be able to adapt this code to your specific need quite easily.
It sounds like you may want a mutable data structure such as a queue.
(make-mod-queue '(dvol: +1 dur: 4 beats)(dvol: -2 dur: 4 beats)...))
#queue((4 (dvol: +1)) (4 (dvol: -2)) ...)
(make-note-queue '(vol: 1, dur: 1 beat)(vol: 1 dur: 2 beats)(vol: 1 dur: 1 beat))
#queue((1 (vol" 1)) (1 (vol: 1)) (2 (vol: 1))
Then a function to combine them
(define (apply-mods note-queue mod-queue)
(let ((new-queue make-empty-queue))
(get-note-dur (lambda ()
(if (emtpy-queue? note-queue)
#f
(car (front-queue note-queue)))))
(get-mod-dur (lambda ()
(if (empty-queue? mod-queue)
#f
(car (front-queue mod-queue)))))
(get-vol
(lambda ()
(if (or (empty-queue? mod-queue) (empty-queue? mod-queue))
#f
(+ (note-vol (front-queue note-queue))
(mod-vol (front-queue mod-queue)))))))
(let loop ((d1 (get-note-dur)) ;;should return #f is note-queue is empty
(d2 (get-mod-dur)) ;;ditto for mod-queue
(vol (get-volume)))
(cond ((not vol)
(cond ((and d2 (not (= d2 (get-mod-dur))))
(set-car! (front-queue mod-queue) d2) new-queue)
new-queue)
((and d1 (not (= d1 (get-note-dur))))
(set-car! (front-queue note-queue) d1) new-queue)
new-queue)
(else new-queue)))
((= d1 d2)
(insert-queue! new-queue (cons d1 (list 'vol: vol)))
(delete-queue! note-queue)
(delete-queue! mod-queue)
(loop (get-note-dur) (get-mod-dur) (get-volume)
((< d1 d2)
(insert-queue! new-queue (cons d1 (list 'vol: vol)))
(delete-queue! note-queue)
(loop (get-note-dur) (- d2 d1) (get-volume)))
((> d1 d2)
(insert-queue! new-queue (cons d2 (list 'vol: vol)))
(delete-queue! mod-queue)
(loop (- d1 d2) (get-mod-dur) (get-volume)))))))
Would return
#queue (1 (vol" 2)) (1 (vol: 2)) (2 (vol: 2)
and your mod-queue (whatever you passed it in as would now be mutated to
#queue (4 (dvol: -2)) ...),
and the original note-queue is now an empty-queue
queues as described in SICP
http://mitpress.mit.edu/sicp/full-text/sicp/book/node62.html