i'm new in scheme syntax.
this is the last part of the project i've been working on.
i was able to find the max from a giving Collatz sequence, but this part of the project requires finding the max length from a multiple Collatz sequences lists.
So for example giving this list : '((1 10) (10 200) (201 210) (900 1000) and the output should be like this : ‘(20 125 89 174)
i need to find the maximum length between the number 1 to 10 and then from 10 to 200 ets
here is my code :
#lang racket
; Part I
(define (sequence n)
(cond [(= n 1)
(list n)]
[(even? n)
( cons n(sequence( / n 2)))]
[(odd? n)
( cons n(sequence (+(* n 3) 1))) ] ))
(sequence 10)
; Part II
(define (find-length items)
(if (null? items)
(list )
(cons
(length (sequence(car items)))
(find-length (rest items))))
)
(find-length (list 10 16 22 90 123 169))
;Part III
(define max-in-list (lambda (ls)
(let ( (head (car ls)) (tail (cdr ls)))
(if (null? tail)
; list contains only one item, return it
head
; else find largest item in tail
(let ((max-in-tail (max-in-list tail)))
; return the larger of 'head' and 'max-in-tail'
(if (> head max-in-tail)
head
max-in-tail
)
)
)
)
))
(define (find-max i j)
( if (= i j)
(list)
(cons
(max-in-list (find-length(sequence i)))
(find-max (+ 1 i ) j)
))
)
(max-in-list(find-max 1 10))
(define (max-length-list items )
(if (null? items)
(list)
(cons
(find-max ? ?) ) ; how i can call this function ?
(max-length-list (?) ) ; how i can call this function ?
)))
(max-length-list '((1 10) (10 200) (201 210) (900 1000) ))
Each item in the list you pass to max-length-list is a list with two numbers and a nil, e.g. (cons 1 (cons 2 '())).
The first number is (car (car items)).
The second is (car (cdr (car items))).
Or, if you let ((head (car items)), then they are (car head) and (car (cdr head)).
The recursive call is trivial; you've processed the first element with find-max, now you just need to process the rest of them. You obviously already know how to accomplish that, since you've done it.
Related
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]);
I tried many ways to solve my assignment but the problem is I guess I miss something or I used something in a wrong way :
my :
solution
(define (return l)
(cond ((null? l) '())
( cond (!= (mod n (car l) 0) )
;; here will check if not equal 0 so it is not
return then I will remove it from the list
((eq? n (car l) )
(return (cdr l)) )
(else (cons (car l) (n (cdr l))))
)
(return n (cdr l) ) ;;if not return then I will keep it in the list
)
The standard way to solve this would be to use filter, as it already does what you want:
(define (divisibleByN n lst)
(filter (lambda (e) (zero? (modulo e n))) lst))
If that's not an acceptable solution, we can use the standard template for traversing a list and building an output list:
(define (divisibleByN n lst)
; base case: if the list is empty, return the empty list
(cond ((null? lst) '())
; if the current number is divisible by n
((zero? (modulo (car lst) n))
; add it to output list and advance recursion
(cons (car lst) (divisibleByN n (cdr lst))))
; otherwise just advance recursion
(else (divisibleByN n (cdr lst)))))
Either way, it works as expected:
(divisibleByN 3 '(5 9 27 14))
=> '(9 27)
(divisibleByN 4 '(15 6))
=> '()
(divisibleByN 7 '())
=> ()
(divisibleByN 5 '(40 40 40 3 10 50))
=> '(40 40 10 50)
The function below is intended to compare every number in a list (2nd parameter) with the first parameter and for every num in the list that is greater than the second param, count it and return the total amount of elements in the list that were greater than the 'threshold'
The code I have doesn't run because I have tried to learn how recursion in Dr. Racket works, but I can't seem to understand. I am just frustrated so just know the code below isn't supposed to be close to working; functional programming isn't my thing, haha.
(define (comp-list threshold list-nums)
(cond [(empty? list-nums) 0]
[(cons? list-nums) (let {[my-var 0]}
(map (if (> threshold (first list-nums))
threshold 2) list-nums ))]))
The following doesn't use lambda of foldl (and is recursive) - can you understand how it works?
(define (comp-list threshold list-nums)
(cond [(empty? list-nums) 0]
[else
(cond [(> (car list-nums) threshold) (+ 1 (comp-list threshold (cdr list-nums)))]
[else (comp-list threshold (cdr list-nums))])]))
Tested:
> (comp-list 1 '(1 1 2 2 3 3))
4
> (comp-list 2 '(1 1 2 2 3 3))
2
> (comp-list 3 '(1 1 2 2 3 3))
0
map takes a procedure as first argument and applied that to every element in the given list(s). Since you are counting something making a list would be wrong.
foldl takes a procedure as first argument, the starting value as second and one or more lists. It applies the procedure with the elements and the starting value (or the intermediate value) and the procedure get to decide the next intermediate value. eg. you can use it to count a list:
(define (my-length lst)
(foldl (lambda (x acc) (+ acc 1))
0
lst))
(my-length '(a b c)) ; ==> 3
You can easily change this to only count when x is greater than some threshold, just evaluate to acc to keep it unchanged when you are not increasing the value.
UPDATE
A recursive solution of my-length:
(define (my-length lst)
;; auxiliary procedure since we need
;; an extra argument for counting
(define (aux lst count)
(if (null? lst)
count
(aux (cdr lst)
(+ count 1))))
;; call auxiliary procedure
(aux lst 0))
The same alteration to the procedure to foldl have to be done with this to only count in some circumstances.
(define (comp-list threshold list-nums)
(cond
[(empty? list-nums) ; there are 0 elements over the threshold in an empty list
0]
[(cons? list-nums) ; in a constructed list, we look at the the first number
(cond
[(< threshold (first list-nums))
(+ 1 ; the first number is over
(comp-list threshold (rest list-nums))] ; add the rest
[else
(comp-list threshold (rest list-nums))])])) ; the first number is lower
A simple functional start
#lang racket
(define (comp-list threshold list-nums)
(define (my-filter-function num)
(< num threshold))
(length (filter my-filter-function list-nums)))
Replacing define with lambda
#lang racket
(define (comp-list threshold list-nums)
(length (filter (lambda (num) (< num threshold))
list-nums)))
Racket's implementation of filter
In DrRacket highlighting the name of a procedure and right clicking and selecting "jump to definition in other file" will allow review of the source code. The source code for filter is instructive:
(define (filter f list)
(unless (and (procedure? f)
(procedure-arity-includes? f 1))
(raise-argument-error 'filter "(any/c . -> . any/c)" f))
(unless (list? list)
(raise-argument-error 'filter "list?" list))
;; accumulating the result and reversing it is currently slightly
;; faster than a plain loop
(let loop ([l list] [result null])
(if (null? l)
(reverse result)
(loop (cdr l) (if (f (car l)) (cons (car l) result) result)))))
I'm trying to find an implementation which flattens a lazy list of lazy lists using interleave and lz-lst-accumulate which are procedures that I wrote. This is the code so far:
(define lz-lst-accumulate
(lambda (op initial lz)
(if (empty? lz)
initial
(op (head lz)
(lambda() (lz-lst-accumulate op initial (tail lz)))))))
(define interleave
(lambda (lz1 lz2)
(if (empty? lz1)
(lz2)
(cons (head lz1)
(interleave (lz2) (lambda() (tail lz1)))))))
(define all-div-from-flattened
(lambda (lower)
(lz-lst-accumulate interleave '() (all-div-from lower))))
(define take
(lambda (lz-lst n)
(if (= n 0)
(list)
(cons (car lz-lst)
(take (tail lz-lst) (sub1 n))))))
(define head
(lambda (lz)
(car lz)))
(define tail
(lambda (lz-lst)
((cdr lz-lst))))
(define lz-lst-map
(lambda (f lz)
(if (empty? lz)
lz
(cons (f (head lz))
(lambda () (lz-lst-map f (tail lz)))))))
; Signature: all-div-from (low)
; Type: [Number -> Lazy-list]
; Purpose: return a lazy-list of lazy-lists. The nested lazy-lists
; correspond to the integers greater than lower in an
; increasing order. Each nested lazy-list is the list of
; all integers divisible by i for some i>=lower.
; Pre-conditions: low is an integer
; Tests: > (define lz3 (all-div-from 7))
; > (take lz3 3)
; '((7 . #<procedure>) (8 . #<procedure>) (9 . #<procedure>))
; > (take (head lz3) 3)
; '(7 14 21)
; > (take (head (tail lz3)) 3)
; '(8 16 24)
(define all-div-from
(lambda(lower)
(cons (lz-lst-map (lambda(x) (* x lower)) (div-from 1 1))
(lambda() (all-div-from (add1 lower))))))
; Signature: div-from (low int)
; Type: [[Number*Number]-> Lazy-list]
; Purpose: return the lazy-list of all integers that
; are larger than low and divisible by int
; Pre-conditions: int > low
; Tests: > (define lz1 (div-from 5 12))
; > (take lz1 3)
; '(12 24 36)
; > (define lz2 (div-from 7 10))
; > (take lz2 4)
; '(10 20 30 40)
(define div-from
(lambda (lower int)
(lz-lst-filter (lambda(x) (> x (- lower 1)))
(lz-lst-map (lambda(x) (* x int)) (integers-from 1)))))
(define integers-from
(lambda (n) (cons n
(lambda () (integers-from (+ 1 n))))))
(define lz-lst-filter
(lambda (p lz)
(cond ((empty? lz) lz)
((p (head lz))
(cons (head lz)
(lambda () (lz-lst-filter p (tail lz)))))
(else (lz-lst-filter p (tail lz))))))
The procedure all-div-from receives a lower bound low and returns a lazy-list of lazy-lists. Each lazy list in it is made by div-from which receives a lower bound low and an integer int > low, and
returns the lazy-list of all integers that are larger than low and divisible by int.
An example of input and the correct output:
> (take (all-div-from-flattened 7) 10)
'(7 8 14 9 21 16 28 10 35 24)
But when I try this line in the interpreter:
> (take (all-div-from-flattened 3) 3)
it gets into an infinite loop.
My implementation must use lz-lst-accumulate, interleave and all-div-from-flattend procedures.
Any suggestions on how to make it work?
Your interleave does not produce a lazy list; it produces an ordinary list: it uses cons with two arguments, with the second argument not wrapped in a lambda. So the cons forces the 2nd argument through, causing the run-away evaluation:
(define interleave
(lambda (lz1 dlz2) ; "delayed" lz2
(if (empty? lz1)
(dlz2)
(cons (head lz1)
; here:
(interleave (dlz2) (lambda () (tail lz1)))))))
(define lz-lst-accumulate
(lambda (op initial lz)
(if (empty? lz)
initial
(op (head lz)
(lambda () (lz-lst-accumulate op initial (tail lz)))))))
(all-div-from lower) produces correct output, ( (lower . <proc1>) . <proc2> ), but the call to (lz-lst-accumulate interleave '() (all-div-from lower)) reduces as
(interleave [lower . <proc1>]
(lambda () (lz-lst-accumulate interleave '() (<proc2>))))
and that reduces as
(cons lower
(interleave (lz-lst-accumulate interleave '() (<proc2>))
(lambda () (<proc1>))))
while it has to reduce as
(cons lower
(lambda () (interleave ....)))
to produce a lazy list.
The obvious (now) solution is to add that missing lambda:
(define interleave
(lambda (lz1 lz2)
(if (empty? lz1)
(lz2)
(cons (head lz1)
(lambda () (interleave (lz2) (lambda() (tail lz1))))))))
Now it runs correctly:
(take (all-div-from-flattened 7) 10)
;Value 12: (7 8 14 9 21 16 28 10 35 24)
You could much simplify your code by introducing
(define integers-from-by
(lambda (n d) (cons n
(lambda () (integers-from (+ n d) d)))))
then,
;(define div-from
; (lambda (lower int)
; (lz-lst-filter (lambda(x) (> x (- lower 1)))
; (lz-lst-map (lambda(x) (* x int)) (integers-from 1)))))
(define mults-from-of ; n in [int, 2*int ..], n >= lower
(lambda (lower int)
(let ((x (* (quotient (+ lower (- int 1)) int) int)))
(integers-from-by x int))))
You could also have
(define mults-above-of ; n in [int, 2*int ..], n > lower
(lambda (lower int)
(let ((x (* (+ (quotient lower int) 1) int)))
(integers-from-by x int))))
Next,
; (define all-div-from
; (lambda(lower)
; (cons (lz-lst-map (lambda(x) (* x lower)) (div-from 1 1))
; (lambda() (all-div-from (add1 lower))))))
(define all-mults-from
(lambda (lower)
(lz-lst-map (lambda (n) (mults-from-of n n))
; or just (integers-from-by n n)
(integers-from-by lower 1))))
If you change your interleave to combine the streams in order, and switch to mults-above-of in the all-mults-from definition, then (lz-lst-accumulate interleave-ordered '() (all-mults-from-above 2)) will define the lazy list of all composite numbers, in order, by means of counting up as in the sieve of Eratosthenes.
From this, it's just one more step to getting yourself your own lazy unbounded incremental sieve of Eratosthenes (search for "SiCp" on that page).
Another remark: take should be tweaked to not force an extra element of a stream. More here.
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