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
Related
I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.
I am following the cs61a spring 2015 class.
One of the problem in the scheme project is:
Implement the list-partitions procedure, which lists all of the ways to
partition a positive integer total without using consecutive integers. The
contents of each partition must be listed in decreasing order.
Hint: Define a helper procedure to construct partitions. The built-in append
procedure creates a list containing all the elements of two argument lists.
The cons-all procedure in questions.scm adds a first element to each list in a list of lists.
The number 5 has 4 partitions that do not contain consecutive integers:
5
4, 1
3, 1, 1
1, 1, 1, 1, 1
The following partitions of 5 are not included because of consecutive
integers:
3, 2
2, 2, 1
2, 1, 1, 1
I found one solution but cannot understand it
;; List all ways to partition TOTAL without using consecutive numbers.
(define (apply-to-all proc items)
(if (null? items)
'()
(cons (proc (car items))
(apply-to-all proc (cdr items)))))
(define (cons-all first rests)
(apply-to-all (lambda (rest) (cons first rest)) rests))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cddr x) (cdr (cdr x)))
(define (cadar x) (car (cdr (car x))))
(define (cdar x) (cdr (car x)))
(define (partitions-r a b)
(if (= a 0) nil
(append (cons-all a (list-partitions b))
(cons-f (partitions-r (- a 1) (+ b 1))
))
))
(define (cons-f lst)
(cond
((eq? lst nil) nil)
((eq? (cdar lst) nil) lst)
((< (caar lst) (cadar lst)) (cons-f (cdr lst)))
((= (caar lst) (+ 1 (cadar lst))) (cons-f (cdr lst)))
(else (cons (car lst) (cons-f (cdr lst))))
))
(define (list-partitions total)
(cond ((= total 1) '((1)) )
((= total 0) '(()) )
(else (append nil (partitions-r total 0)))
))
; For these two tests, any permutation of the right answer will be accepted.
(list-partitions 5)
; expect ((5) (4 1) (3 1 1) (1 1 1 1 1))
(list-partitions 7)
; expect ((7) (6 1) (5 2) (5 1 1) (4 1 1 1) (3 3 1) (3 1 1 1 1) (1 1 1 1 1 1 1))
What does the function partitions-r and cons-f do? Thank you very much!
Don't know Scheme, but recursive generation in pseudocode might look like:
function Partitions(N, LastValue, list):
if N = 0
print list
else
for i from Min(LastValue, N) downto 1
if (i != LastValue - 1) //reject consecutive number
Partitions(N - i, i, list + [i]);
So I am familiar with the algorithm for creating a power set using Scheme that looks something like this:
(define (power-set set)
(if (null? set) '(())
(let ((power-set-of-rest (power-set (cdr set))))
(append power-set-of-rest
(map (lambda (subset) (cons (car set) subset))
power-set-of-rest)))))
So this, for (1, 2, 3, 4), would output:
(() (4) (3) (3 4) (2) (2 4) (2 3) (2 3 4) (1) (1 4) (1 3) (1 3 4) (1 2) (1 2 4)
(1 2 3) (1 2 3 4))
I need to figure out how to output the power set "in order", for example:
(() (1) (2) (3) (4) (1 2) (1 3) (1 4) (2 3) (2 4) (3 4) (1 2 3) (1 2 4) (1 3 4)
(2 3 4) (1 2 3 4))
Doing a little research, it seems as if the best option would be for me to run a sort before outputting. I am NOT allowed to use built in sorts, so I have found some example sorts for sorting a list:
(define (qsort e)
(if (or (null? e) (<= (length e) 1))
e
(let loop ((left null) (right null)
(pivot (car e)) (rest (cdr e)))
(if (null? rest)
(append (append (qsort left) (list pivot)) (qsort right))
(if (<= (car rest) pivot)
(loop (append left (list (car rest))) right pivot (cdr rest))
(loop left (append right (list (car rest))) pivot (cdr rest)))))))
I cannot figure out how I would go about sorting it based off of the second, or third element in one of the power sets though. Can anyone provide an example?
Here's a powerset function that returns the items in the correct order, without sorting. It requires Racket and uses its queues to implement breadth-first processing:
(require srfi/1 data/queue)
(define (powerset items)
(define fifo (make-queue))
(enqueue! fifo (cons '() items))
(let loop ((result '()))
(if (queue-empty? fifo)
(reverse result)
(let* ((head-entry (dequeue! fifo))
(subset (car head-entry))
(rest-items (cdr head-entry)))
(pair-for-each (lambda (next-items)
(enqueue! fifo (cons (cons (car next-items) subset)
(cdr next-items))))
rest-items)
(loop (cons (reverse subset) result))))))
We maintain a FIFO queue of pairs, each consisting of a subset (in reversed order) and a list of items not included in it, starting with an empty subset so all the original items are still not included in it.
For each such pair, we collect the subset into the result list, and also extend the queue by extending this subset by each item from the not-included items. Processing stops when the queue is empty.
Because we extend subsets each time by one element only, and in order, the result is ordered too.
Here's a compare function that should work for your needs. It assumes that the numbers in the two input arguments are sorted already.
(define (list-less? lst1 lst2)
;; Compare the contents of the lists.
(define (helper l1 l2)
;; If two lists are identical, the answer is false.
;; This scenario won't be exercised in the problem.
;; It's here only for the sake of completeness.
(if (null? l1)
#f
;; If the first item of the second list is greater than
;; the first item, return true.
(if (> (car l2) (car l1))
#t
(or (< (car l1) (car l2)) (helper (cdr l1) (cdr l2))))))
;; First compare the lengths of the input arguments.
;; A list of smaller length are assumed to be "less"
;; than list of greater length.
;; Only when the lists are of equal length, do we
;; compare the contents of the lists.
(let ((len1 (length lst1)) (len2 (length lst2)))
(if (> len1 len2)
#f
(or (< len1 len2) (helper lst1 lst2)))))
how to implement this function
if get two list (a b c), (d e)
and return list (a+d b+d c+d a+e b+e c+e)
list element is all integer and result list's element order is free
I tried this like
(define (addlist L1 L2)
(define l1 (length L1))
(define l2 (length L2))
(let ((result '()))
(for ((i (in-range l1)))
(for ((j (in-range l2)))
(append result (list (+ (list-ref L1 i) (list-ref L2 j))))))))
but it return error because result is '()
I don't know how to solve this problem please help me
A data-transformational approach:
(a b c ...) (x y ...)
1. ==> ( ((a x) (b x) (c x) ...) ((a y) (b y) (c y) ...) ...)
2. ==> ( (a x) (b x) (c x) ... (a y) (b y) (c y) ... ...)
3. ==> ( (a+x) (b+x) ... )
(define (addlist L1 L2)
(map (lambda (r) (apply + r)) ; 3. sum the pairs up
(reduce append '() ; 2. concatenate the lists
(map (lambda (e2) ; 1. pair-up the elements
(map (lambda (e1)
(list e1 e2)) ; combine two elements with `list`
L1))
L2))))
testing (in MIT-Scheme):
(addlist '(1 2 3) '(10 20))
;Value 23: (11 12 13 21 22 23)
Can you simplify this so there's no separate step #3?
We can further separate out the different bits and pieces in play here, as
(define (bind L f) (join (map f L)))
(define (join L) (reduce append '() L))
(define yield list)
then,
(bind '(1 2 3) (lambda (x) (bind '(10 20) (lambda (y) (yield (+ x y))))))
;Value 13: (11 21 12 22 13 23)
(bind '(10 20) (lambda (x) (bind '(1 2 3) (lambda (y) (yield (+ x y))))))
;Value 14: (11 12 13 21 22 23)
Here you go:
(define (addlist L1 L2)
(for*/list ((i (in-list L1)) (j (in-list L2)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 21 12 22 13 23)
The trick is to use for/list (or for*/list in case of nested fors) , which will automatically do the append for you. Also, note that you can just iterate over the lists, no need to work with indexes.
To get the result "the other way round", invert L1 and L2:
(define (addlist L1 L2)
(for*/list ((i (in-list L2)) (j (in-list L1)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 12 13 21 22 23)
In scheme, it's not recommended using function like set! or append!.
because it cause data changed or Variable, not as Funcitonal Programming Style.
should like this:
(define (add-one-list val lst)
(if (null? lst) '()
(cons (list val (car lst)) (add-one-list val (cdr lst)))))
(define (add-list lst0 lst1)
(if (null? lst0) '()
(append (add-one-list (car lst0) lst1)
(add-list (cdr lst0) lst1))))
first understanding function add-one-list, it recursively call itself, and every time build val and fist element of lst to a list, and CONS/accumulate it as final answer.
add-list function just like add-one-list.
(define (addlist L1 L2)
(flatmap (lambda (x) (map (lambda (y) (+ x y)) L1)) L2))
(define (flatmap f L)
(if (null? L)
'()
(append (f (car L)) (flatmap f (cdr L)))))
1 ]=> (addlist '(1 2 3) '(10 20))
;Value 2: (11 12 13 21 22 23)
Going with Will and Procras on this one. If you're going to use scheme, might as well use idiomatic scheme.
Using for to build a list is a bit weird to me. (list comprehensions would fit better) For is usually used to induce sequential side effects. That and RSR5 does not define a for/list or for*/list.
Flatmap is a fairly common functional paradigm where you use append instead of cons to build a list to avoid nested and empty sublists
It doesn't work because functions like append don't mutate the containers. You could fix your problem with a mutating function like append!. Usually functions that mutate have a ! in their name like set! etc.
But it's possible to achieve that without doing mutation. You'd have to change your algorithm to send the result to your next iteration. Like this:
(let loop ((result '()))
(loop (append result '(1)))
As you can see, when loop will get called, result will be:
'()
'(1)
'(1 1)
'(1 1 1)
....
Following this logic you should be able to change your algorithm to use this method instead of for loop. You'll have to pass some more parameters to know when you have to exit and return result.
I'll try to add a more complete answer later today.
Here's an implementation of append! I just wrote:
(define (append! lst1 lst2)
(if (null? (cdr lst1))
(set-cdr! lst1 lst2)
(append! (cdr lst1) lst2)))
I don't fully understand what the append-map command does in racket, nor do I understand how to use it and I'm having a pretty hard time finding some decently understandable documentation online for it. Could someone possibly demonstrate what exactly the command does and how it works?
The append-map procedure is useful for creating a single list out of a list of sublists after applying a procedure to each sublist. In other words, this code:
(append-map proc lst)
... Is semantically equivalent to this:
(apply append (map proc lst))
... Or this:
(append* (map proc lst))
The applying-append-to-a-list-of-sublists idiom is sometimes known as flattening a list of sublists. Let's look at some examples, this one is right here in the documentation:
(append-map vector->list '(#(1) #(2 3) #(4)))
'(1 2 3 4)
For a more interesting example, take a look at this code from Rosetta Code for finding all permutations of a list:
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute l)
(if (null? l)
'(())
(apply append (map (lambda (p)
(map (lambda (n)
(insert p n (car l)))
(seq 0 (length p))))
(permute (cdr l))))))
The last procedure can be expressed more concisely by using append-map:
(define (permute l)
(if (null? l)
'(())
(append-map (lambda (p)
(map (lambda (n)
(insert p n (car l)))
(seq 0 (length p))))
(permute (cdr l)))))
Either way, the result is as expected:
(permute '(1 2 3))
=> '((1 2 3) (2 1 3) (2 3 1) (1 3 2) (3 1 2) (3 2 1))
In Common Lisp, the function is named "mapcan" and it is sometimes used to combine filtering with mapping:
* (mapcan (lambda (n) (if (oddp n) (list (* n n)) '()))
'(0 1 2 3 4 5 6 7))
(1 9 25 49)
In Racket that would be:
> (append-map (lambda (n) (if (odd? n) (list (* n n)) '()))
(range 8))
'(1 9 25 49)
But it's better to do it this way:
> (filter-map (lambda (n) (and (odd? n) (* n n))) (range 8))
'(1 9 25 49)