(define-struct person (name house kids))
;; A Person is (make-person String String ListOfPerson)
;; interp. A person, with name, house and list of children.
(define P0 (make-person "Draco" "Slytherin" empty))
(define P1 (make-person "Nymphadora" "Hufflepuff" empty))
(define P2 (make-person "Sirius" "Griffindor" empty))
(define P3 (make-person "Regulus" "Slytherin" empty))
(define P4 (make-person "Bellatrix" "Slytherin" empty))
(define P5 (make-person "Andromeda" "Slytherin" (list P1)))
(define P6 (make-person "Narcissa" "Slytherin" (list P0)))
(define P7 (make-person "Walburga" "Slytherin" (list P2 P3)))
(define P8 (make-person "Alphard" "Slytherin" empty))
(define P9 (make-person "Cygnus" "Slytherin" (list P4 P5 P6)))
(define P10 (make-person "Irma" "Slytherin" (list P7 P8 P9)))
original structured reference
;; Person -> Natural
;; Count number of people in a tree
(check-expect (count P0) 1)
(check-expect (count P5) 2)
(check-expect (count P10) 11)
(define (count p)
(local
[(define (count/person p)
(add1 (count/lop (person-kids p))))
(define (count/lop lop)
(cond [(empty? lop) 0]
[else
(+ (count/person (first lop))
(count/lop (rest lop)))]))]
(count/person p)))
this is the solution
(define (count p)
(local
[(define (count/person p result todo)
(count/lop (add1 result)
(append (person-kids p) todo)))
(define (count/lop result todo)
(cond [(empty? todo) result]
[else
(count/person (first todo)
result
(rest todo))]))])
(count/person p 0 empty))
;; Accumulator result is Natural
;; Invariant: the total computed so far
;; Accumulator todo is (listof Person)
;; Invariant: persons not yet visited by count/person
I have trouble understand how this comes from the initial normal mutual reference solution, could anyone explain this to me?
Your solution does not follow the basic design recipe.
Here is an attempt to make a straight-forward solution:
(define-struct person (kids))
; sum : list-of-numbers -> number
(define (sum xs)
(cond
[(empty? xs) 0]
[else (+ (first xs) (sum (rest xs)))]))
; count : person -> number
(define (count p)
(cond
[(empty? (person-kids p)) 1] ; p is 1 person, 0 kids
[else (+ 1 ; p is 1 person and
(sum (map count ; we must sum over the
(person-kids p))))])) ; count of each kid
In chapter 30 and 31 of How to Design Programs, you can read about the conversion from this style to accumulator style (which your solution uses). Details in the conversion is in section 31.3.
HtDP section 31.3 'Transforming Functions into Accumulator-Style'
Related
I have tried to abstract both functions (good-job and total-length) by creating a new abstraction function called new-num and this is what I have so far but I keep getting errors so I assume I am abstracting incorrectly:
; good-job : [List-of NonNegReal] -> [List-of NonNegReal]
; adds 20% to all supplied costs
(define (good-job lon)
(cond
[(empty? lon) '()]
[(cons? lon)
(cons
(add-thanks (first lon))
(good-job (rest lon)))]))
; add-thanks : NonNegReal -> NonNegReal
; adds 20% to the supplied cost
(define (add-thanks cost)
(* cost 1.2))
; total-length : [List-of String] -> Nat
; returns the total length of all strings in the list
(define (total-length los)
(cond
[(empty? los) 0]
[(cons? los)
(+
(string-length (first los))
(total-length (rest los)))]))
; new-num : [List-of X] X -> X
; abstracts good-job and total-length
; functions
(define (new-num lox cons/+ add-thanks/string-length def)
(cond
[(empty? lox) def]
[(cons? lox)
(cons/+
(add-thanks/string-length (first lox))
(new-num (rest lox) cons/+ add-thanks/string-length def))]))
I want to initialize acc as 0. I want to add the length of each element of lst. I understand this is not the easiest way to do it, but I simplified my real code for this example. How exactly can I accumulate the total length and assign it to acc.
Also, I am trying to avoid using set! or other ! commands.
(define (total-length-list lst)
(define acc 0)
(for/list ([i lst])
(cond [(= 0 (length i)) (+ acc 0)]
[(= 1 (length i)) (+ acc 1)]
[(= 2 (length i)) (+ acc 2)]))
acc)
From your description I would implement it with apply and map.
;; total-length-list : [Listof [Listof Any]] -> Natural
(define (total-length-list lst)
(apply + (map length lst)))
If you want to use a loop, then for/sum is good.
;; total-length-list : [Listof [Listof Any]] -> Natural
(define (total-length-list lst)
(for/sum ([i lst])
(length i)))
If you want to use an accumulator, for/fold can do that.
;; total-length-list : [Listof [Listof Any]] -> Natural
(define (total-length-list lst)
(for/fold ([acc 0]) ([i lst])
(+ acc (length i))))
And if you still want that cond for some reason, you can put that inside the for/fold, but make sure to have an else case that returns the accumulator unchanged.
;; total-length-list : [Listof [Listof Any]] -> Natural
(define (total-length-list lst)
(for/fold ([acc 0]) ([i lst])
(cond [(= 0 (length i)) (+ acc 0)]
[(= 1 (length i)) (+ acc 1)]
[(= 2 (length i)) (+ acc 2)]
[else acc])))
If you leave out the [else acc] in the cond you might get an error about #<void>.
But simpler is better, so I would recommend either using apply with map, or using for/sum, no accumulators or conditionals necessary.
From an imperative programmer's point of view,
(for/fold ([acc init]) ([elem lst])
body)
returns the same value as
(define acc init)
(for ([elem lst])
(set! acc body))
acc
However, for/fold does it without any mutation/set! necessary.
I am trying to write a racket program that computes the sum of the first n terms in a fibonacci sequence without using recursion, and only using abstract list functions (so map, builld-list, foldr, foldl). I can use helper functions.
I'm stuck on how to make a list of the fibonacci numbers without using recursion. I thought I could use a lambda function:
(lambda (lst) (+ (list-ref lst (- (length lst) 1)) (list-ref lst (- (length lst 2)))))
But I am not sure how to generate the input list/how to add this to a function.
Once I have a fibonacci sequence I know I can just use (foldl + (car lst) (cdr lst)) to find the sum.
Could anyone explain to me how to make the fibonacci sequence/give me a hint?
; This is how I figure out
#|
(1 2 3 4 (0 1))
-> (1 2 3 (1 1))
-> (1 2 (1 2))
-> (1 (2 3))
-> (3 5)
|#
(define (fib n)
(cond
[(= n 0) 0]
[(= n 1) 1]
[(> n 1)
(second
(foldr (λ (no-use ls) (list (second ls) (+ (first ls) (second ls))))
'(0 1)
(build-list (- n 1) (λ (x) x))))]))
(fib 10)
(build-list 10 fib)
Upgrade version 2
(define (fib-v2 n)
(first
(foldr (λ (no-use ls) (list (second ls) (+ (first ls) (second ls))))
'(0 1)
(build-list n (λ (x) x)))))
(build-list 10 fib-v2)
fib-seq produces a list of first n fibonacci numbers and fib-sum produces the sum of first n fibonacci numbers.
; Number -> [List-of Number]
(define (fib-seq n)
(cond [(= n 0) '()]
[(= n 1) '(0)]
[else (reverse
(for/fold ([lon '(1 0)]) ([_ (in-range (- n 2))])
(cons (apply + (take lon 2)) lon)))]))
; Number -> Number
(define (fib-sum n)
(if (= n 0) 0 (add1 (apply + (take (fib-seq n) (sub1 n))))))
Note: fib-sum is equivalent to the following recursive versions:
(define (fib0 n)
(if (< n 2) n (+ (fib0 (- n 1)) (fib0 (- n 2)))))
(define (fib1 n)
(let loop ((cnt 0) (a 0) (b 1))
(if (= n cnt) a (loop (+ cnt 1) b (+ a b)))))
(define (fib2 n (a 0) (b 1))
(if (= n 0) 0 (if (< n 2) 1 (+ a (fib2 (- n 1) b (+ a b))))))
Once I have a fibonacci sequence I know I can just use (foldl + (car lst) (cdr lst)) to find the sum.
Note that you don't have to generate an intermediate sequence to find the sum. Consider the (fast) matrix exponentiation solution:
(require math/matrix)
(define (fib3 n)
(matrix-ref (matrix-expt (matrix ([1 1] [1 0])) n) 1 0))
Testing:
(require rackunit)
(check-true
(let* ([l (build-list 20 identity)]
[fl (list fib0 fib1 fib2 fib3 fib-sum)]
[ll (make-list (length fl) l)])
(andmap (λ (x) (equal? (map fib0 l) x))
(map (λ (x y) (map x y)) fl ll))))
I am trying to create a function called lcm-from-factors that computes the Lowest Common Multiple of two numbers (m and n) The inputs to the function are m-co-groups and n-co-groups, which list all the prime factors and their powers. For instance, for m= 2970 and n= 163,800, we will have:
m-co-groups= ’((2 1) (3 3) (5 1) (7 0) (11 1) (13 0))
n-co-groups= ’((2 3) (3 2) (5 2) (7 1) (11 0) (13 1))
These are returned by a function called co-factor which has been given to me. I have written the code but the function is not compiling because I believe I did not implement the recursion properly. I'd appreciate any help in figuring out what I am doing wrong. My code is as follows.
(define (lcm-from-factors m n)
(let-values (((m-co-groups n-co-groups) (co-factor m n)))
(define (recurse m-co-groups n-co-groups)
(let* ((a (first(m-co-groups)))
(b (first(n-co-groups))))
(cond ((>= (rest(a)) (rest(b)))
(+ (expt (first(a)) (rest(a))) (recurse (rest(m-co-groups)) (rest(n-co-groups)))))
(else (+ (expt (first(b)) (rest(b))) (recurse (rest(m-co-groups)) (rest(n-co-groups))))))))))
The following is a stepping stone to get you started.
The code handles the specific situation where m and n has the same prime factors.
It is your job, to figure out how to handle the other cases.
#lang racket
(require math/number-theory)
(define (co-factor m n) (values (factorize m) (factorize n)))
(define (exponent power) (second power))
(define (base power) (first power))
(define (lcm-from-factors m n)
(let-values ([(m-co-groups n-co-groups) (co-factor m n)])
(define (recurse m-co-groups n-co-groups)
(cond
[(and (empty? m-co-groups) (empty? n-co-groups)) 1]
[(empty? m-co-groups) 'something-1]
[(empty? n-co-groups) 'something-2]
[else
(define a-power (first m-co-groups))
(define b-power (first n-co-groups))
(define a-base (base a-power))
(define b-base (base b-power))
(define a-exp (exponent a-power))
(define b-exp (exponent b-power))
(cond
[(= a-base b-base) (* (expt a-base (max a-exp b-exp))
(recurse (rest m-co-groups) (rest n-co-groups)))]
[(< a-base b-base) 'something-3]
[(> a-base b-base) 'something-4])]))
(recurse m-co-groups n-co-groups)))
(define x (* (expt 2 3) (expt 3 4)))
(define y (* (expt 2 1) (expt 3 5)))
(lcm-from-factors x y) ; gives 1944
(lcm x y) ; gives 1944
I am trying to write a Scheme macro that loops over the prime numbers. Here is a simple version of the macro:
(define-syntax do-primes
(syntax-rules ()
((do-primes (p lo hi) (binding ...) (test res ...) exp ...)
(do ((p (next-prime (- lo 1)) (next-prime p)) binding ...)
((or test (< hi p)) res ...) exp ...))
((do-primes (p lo) (binding ...) (test res ...) exp ...)
(do ((p (next-prime (- lo 1)) (next-prime p)) binding ...)
(test res ...) exp ...))
((do-primes (p) (binding ...) (test res ...) exp ...)
(do ((p 2 (next-prime p)) binding ...) (test res ...) exp ...))))
The do-primes macro expands to a do with three possible syntaxes: if the first argument to do-primes is (p lo hi) then the do loops over the primes from lo to hi unless iteration is stopped early by the termination clause, if the first argument to do-primes is (p lo) then the do loops over the primes starting from lo and continuing until the termination clause stops the iteration, and if the first argument to do-primes is (p) then the do loops over the primes starting from 2 and continuing until the termination clause stops the iteration. Here are some sample uses of the do-primes macro:
; these lines display the primes less than 25
(do-primes (p 2 25) () (#f) (display p) (newline))
(do-primes (p 2) () ((< 25 p)) (display p) (newline))
(do-primes (p) () ((< 25 p)) (display p) (newline))
; these lines return a list of the primes less than 25
(do-primes (p 2 25) ((ps (list) (cons p ps))) (#f (reverse ps)))
(do-primes (p 2) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps)))
(do-primes (p) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps)))
; these lines return the sum of the primes less than 25
(do-primes (p 2 25) ((s 0 (+ s p))) (#f s))
(do-primes (p 2) ((s 0 (+ s p))) ((< 25 p) s))
(do-primes (p) ((s 0 (+ s p))) ((< 25 p) s))
What I want to do is write a version of the do-primes macro that uses a local version of the next-prime function; I want to do that because I can make the next-prime function run faster than my general-purpose next-prime function because I know the environment in which it will be called. I tried to write the macro like this:
(define-syntax do-primes
(let ()
(define (prime? n)
(if (< n 2) #f
(let loop ((f 2))
(if (< n (* f f)) #t
(if (zero? (modulo n f)) #f
(loop (+ f 1)))))))
(define (next-prime n)
(let loop ((n (+ n 1)))
(if (prime? n) n (loop (+ n 1)))))
(lambda (x) (syntax-case x ()
((do-primes (p lo hi) (binding ...) (test res ...) exp ...)
(syntax
(do ((p (next-prime (- lo 1)) (next-prime p)) binding ...)
((or test (< hi p)) res ...) exp ...)))
((do-primes (p lo) (binding ...) (test res ...) exp ...)
(syntax
(do ((p (next-prime (- lo 1)) (next-prime p)) binding ...)
(test res ...) exp ...)))
((do-primes (p) (binding ...) (test res ...) exp ...)
(syntax
(do ((p 2 (next-prime p)) binding ...) (test res ...) exp ...))))))))
(Ignore the prime? and next-prime functions, which are there only for illustration. The real version of the do-primes macro will use a segmented sieve for small primes and switch to a Baillie-Wagstaff pseudoprime test for larger primes.) But that doesn't work; I get an error message telling me that that I am trying "to reference out-of-phase identifier next-prime." I understand the problem. But my macrology wizardry is insufficient to solve it.
Can someone show me how to write the do-primes macro?
EDIT: Here is the final macro:
(define-syntax do-primes (syntax-rules () ; syntax for iterating over primes
; (do-primes (p lo hi) ((var init next) ...) (pred? result ...) expr ...)
; Macro do-primes provides syntax for iterating over primes. It expands to
; a do-loop with variable p bound in the same scope as the rest of the (var
; init next) variables, as if it were defined as (do ((p (primes lo hi) (cdr
; p)) (var init next) ...) (pred result ...) expr ...). Variables lo and hi
; are inclusive; for instance, given (p 2 11), p will take on the values 2,
; 3, 5, 7 and 11. If hi is omitted the iteration continues until stopped by
; pred?. If lo is also omitted iteration starts from 2. Some examples:
; three ways to display the primes less than 25
; (do-primes (p 2 25) () (#f) (display p) (newline))
; (do-primes (p 2) () ((< 25 p)) (display p) (newline))
; (do-primes (p) () ((< 25 p)) (display p) (newline))
; three ways to return a list of the primes less than 25
; (do-primes (p 2 25) ((ps (list) (cons p ps))) (#f (reverse ps)))
; (do-primes (p 2) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps)))
; (do-primes (p) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps)))
; three ways to return the sum of the primes less than 25
; (do-primes (p 2 25) ((s 0 (+ s p))) (#f s))
; (do-primes (p 2) ((s 0 (+ s p))) ((< 25 p) s))
; (do-primes (p) ((s 0 (+ s p))) ((< 25 p) s))
; functions to count primes and return the nth prime (from P[1] = 2)
; (define (prime-pi n) (do-primes (p) ((k 0 (+ k 1))) ((< n p) k)))
; (define (nth-prime n) (do-primes (p) ((n n (- n 1))) ((= n 1) p)))
; The algorithm used to generate primes is a segmented Sieve of Eratosthenes
; up to 2^32. For larger primes, a segmented sieve runs over the sieving
; primes up to 2^16 to produce prime candidates, then a Baillie-Wagstaff
; pseudoprimality test is performed to confirm the number is prime.
; If functions primes, expm, jacobi, strong-pseudoprime?, lucas, selfridge
; and lucas-pseudoprime? exist in the outer environment, they can be removed
; from the macro.
((do-primes (p lo hi) (binding ...) (test result ...) expr ...)
(do-primes (p lo) (binding ...) ((or test (< hi p)) result ...) expr ...))
((do-primes (pp low) (binding ...) (test result ...) expr ...)
(let* ((limit (expt 2 16)) (delta 50000) (limit2 (* limit limit))
(sieve (make-vector delta #t)) (ps #f) (qs #f) (bottom 0) (pos 0))
(define (primes n) ; sieve of eratosthenes
(let ((sieve (make-vector n #t)))
(let loop ((p 2) (ps (list)))
(cond ((= n p) (reverse ps))
((vector-ref sieve p)
(do ((i (* p p) (+ i p))) ((<= n i))
(vector-set! sieve i #f))
(loop (+ p 1) (cons p ps)))
(else (loop (+ p 1) ps))))))
(define (expm b e m) ; modular exponentiation
(let loop ((b b) (e e) (x 1))
(if (zero? e) x
(loop (modulo (* b b) m) (quotient e 2)
(if (odd? e) (modulo (* b x) m) x)))))
(define (jacobi a m) ; jacobi symbol
(let loop1 ((a (modulo a m)) (m m) (t 1))
(if (zero? a) (if (= m 1) t 0)
(let ((z (if (member (modulo m 8) (list 3 5)) -1 1)))
(let loop2 ((a a) (t t))
(if (even? a) (loop2 (/ a 2) (* t z))
(loop1 (modulo m a) a
(if (and (= (modulo a 4) 3)
(= (modulo m 4) 3))
(- t) t))))))))
(define (strong-pseudoprime? n a) ; strong pseudoprime base a
(let loop ((r 0) (s (- n 1)))
(if (even? s) (loop (+ r 1) (/ s 2))
(if (= (expm a s n) 1) #t
(let loop ((r r) (s s))
(cond ((zero? r) #f)
((= (expm a s n) (- n 1)) #t)
(else (loop (- r 1) (* s 2)))))))))
(define (lucas p q m n) ; lucas sequences u[n] and v[n] and q^n (mod m)
(define (even e o) (if (even? n) e o))
(define (mod n) (if (zero? m) n (modulo n m)))
(let ((d (- (* p p) (* 4 q))))
(let loop ((un 1) (vn p) (qn q) (n (quotient n 2))
(u (even 0 1)) (v (even 2 p)) (k (even 1 q)))
(if (zero? n) (values u v k)
(let ((u2 (mod (* un vn))) (v2 (mod (- (* vn vn) (* 2 qn))))
(q2 (mod (* qn qn))) (n2 (quotient n 2)))
(if (even? n) (loop u2 v2 q2 n2 u v k)
(let* ((uu (+ (* u v2) (* u2 v)))
(vv (+ (* v v2) (* d u u2)))
(uu (if (and (positive? m) (odd? uu)) (+ uu m) uu))
(vv (if (and (positive? m) (odd? vv)) (+ vv m) vv))
(uu (mod (/ uu 2))) (vv (mod (/ vv 2))))
(loop u2 v2 q2 n2 uu vv (* k q2)))))))))
(define (selfridge n) ; initialize lucas sequence
(let loop ((d-abs 5) (sign 1))
(let ((d (* d-abs sign)))
(cond ((< 1 (gcd d n)) (values d 0 0))
((= (jacobi d n) -1) (values d 1 (/ (- 1 d) 4)))
(else (loop (+ d-abs 2) (- sign)))))))
(define (lucas-pseudoprime? n) ; standard lucas pseudoprime
(call-with-values
(lambda () (selfridge n))
(lambda (d p q)
(if (zero? p) (= n d)
(call-with-values
(lambda () (lucas p q n (+ n 1)))
(lambda (u v qkd) (zero? u)))))))
(define (init lo) ; initialize sieve, return first prime
(set! bottom (if (< lo 3) 2 (if (odd? lo) (- lo 1) lo)))
(set! ps (cdr (primes limit))) (set! pos 0)
(set! qs (map (lambda (p) (modulo (/ (+ bottom p 1) -2) p)) ps))
(do ((p ps (cdr p)) (q qs (cdr q))) ((null? p))
(do ((i (+ (car p) (car q)) (+ i (car p)))) ((<= delta i))
(vector-set! sieve i #f)))
(if (< lo 3) 2 (next)))
(define (advance) ; advance to next segment
(set! bottom (+ bottom delta delta)) (set! pos 0)
(do ((i 0 (+ i 1))) ((= i delta)) (vector-set! sieve i #t))
(set! qs (map (lambda (p q) (modulo (- q delta) p)) ps qs))
(do ((p ps (cdr p)) (q qs (cdr q))) ((null? p))
(do ((i (car q) (+ i (car p)))) ((<= delta i))
(vector-set! sieve i #f))))
(define (next) ; next prime after current prime
(when (= pos delta) (advance))
(let ((p (+ bottom pos pos 1)))
(if (and (vector-ref sieve pos) (or (< p limit2)
(and (strong-pseudoprime? p 2) (lucas-pseudoprime? p))))
(begin (set! pos (+ pos 1)) p)
(begin (set! pos (+ pos 1)) (next)))))
(do ((pp (init low) (next)) binding ...) (test result ...) expr ...)))
((do-primes (p) (binding ...) (test result ...) expr ...)
(do-primes (p 2) (binding ...) (test result ...) expr ...))))
To get correct phasing, your next-prime needs to defined within the macro output. Here's one way to go about it (tested with Racket):
(define-syntax do-primes
(syntax-rules ()
((do-primes (p lo hi) (binding ...) (test res ...) exp ...)
(do-primes (p lo) (binding ...) ((or test (< hi p)) res ...) exp ...))
((do-primes (p lo) (binding ...) (test res ...) exp ...)
(let ()
(define (prime? n)
...)
(define (next-prime n)
...)
(do ((p (next-prime (- lo 1)) (next-prime p)) binding ...)
(test res ...)
exp ...)))
((do-primes (p) (binding ...) (test res ...) exp ...)
(do-primes (p 2) (binding ...) (test res ...) exp ...))))
This way, this defines the prime? and next-prime in the most local scope possible, while not having tons of duplicate code in your macro definition (since the 1- and 3-argument forms are simply rewritten to use the 2-argument form).