commit 31d105aa3d3ce6320aa36ae76136713dcab05a10
parent 868e1bd403b3fcda7e5d538c5fe0250abe289667
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sat, 11 Mar 2023 14:07:59 +0200
More solutions.
Diffstat:
| M | guile.scm | | | 252 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- |
1 file changed, 248 insertions(+), 4 deletions(-)
diff --git a/guile.scm b/guile.scm
@@ -8,8 +8,9 @@
(srfi srfi-42) ; list comprehensions with list-ec.
(srfi srfi-64) ; test-begin, test-equal, and test-end.
(statprof)
- (ice-9 time)
+ (ice-9 pretty-print)
(ice-9 textual-ports)
+ (ice-9 time)
)
(use-modules (ice-9 format))
@@ -2013,7 +2014,7 @@ Iterative.
(car mobile))
'(define (right-branch mobile)
- (cadr mobile))
+ (cadr mobile))
(define (right-branch mobile)
(cdr mobile))
@@ -2022,7 +2023,7 @@ Iterative.
(car branch))
'(define (branch-structure branch)
- (cadr branch))
+ (cadr branch))
(define (branch-structure branch)
(cdr branch))
@@ -2167,9 +2168,252 @@ Iterative.
;; Exercise 2.32
(define (exercise-2.32)
- '()
+ (define (subsets s)
+ (if (null? s)
+ (list '())
+ (let ([rest (subsets (cdr s))])
+ (append rest
+ (map (lambda (x)
+ (cons (car s)
+ x))
+ rest)))))
+
+ (subsets '())
+ (if (null? '())
+ (list '())
+ (let ([rest (subsets (cdr s))])
+ (append rest
+ (map (lambda (x)
+ (cons (car s)
+ x))
+ rest))))
+ (list '())
+
+ (subsets '(1))
+ (if (null? '(1))
+ (list '())
+ (let ([rest (subsets (cdr '(1)))])
+ (append rest
+ (map (lambda (x)
+ (cons (car '(1))
+ x))
+ rest))))
+ (let ([rest (subsets (cdr '(1)))])
+ (append rest
+ (map (lambda (x)
+ (cons (car '(1))
+ x))
+ rest)))
+ (let ([rest (subsets '())])
+ (append rest
+ (map (lambda (x)
+ (cons (car '(1))
+ x))
+ rest)))
+ (append '(())
+ (map (lambda (x)
+ (cons 1 x))
+ '(())))
+ (append '(())
+ (list (cons 1 '())))
+ (append (list '())
+ (list (list 1)))
+ (list '() (list 1))
+
+ ;; We go deep into the list each time we [rest (subset (cdr s))].
+ ;; The first rest we really get is '().
+ ;; Then we append (list rest) to (map ... rest).
+ ;; (map ... rest) is (map ... '()), so it's '().
+ ;; (list rest) is '(()), so we append '(()) to '(),
+ ;; which is '(()). We return that to the above procedure call
+ ;; and now rest is '(()).
+ ;; We append '(()) to (map ... '(())).
+ ;; This time we map over a non-empty list, so the map proc
+ ;; is important. It is (map (lambda (x) (cons (car s) x)) rest).
+ ;; That is, we attach the current first element of s to each of
+ ;; the elements of rest. Because this is done from the last to first
+ ;; items of s in the subsets call stack, we first cons the last element
+ ;; first while unwinding the callstack.
+ ;; (map ... rest) is (list (cons (car s) '())), so (map ...)
+ ;; is (list (list s-item-n)). rest is '(()), so attaching
+ ;; '(()) to (list s-item-n) is (list '() (list s-item-n)).
+ ;; We return that and assign to rest.
+ ;; Now rest is (list '() (list s-item-n)).
+ ;; We attach (list '() (list s-item-n)) to
+ ;; (list (list s-item-n-1) (list s-item-n-1 s-item-n))
+ ;; thereby getting (list '() (list s-item-n) (list s-item-n-1) (list s-item-n-1 s-item-n))
+ ;; and we see the pattern. Each time we go up the call stack we append the previous combinations,
+ ;; rest, to the list where s-item-i was consed to each of the elements of rest.
+ ;; So at each point we append the list, rest, where s-item-i did not appear to the list
+ ;; where it did appear and return that.
+ ;; In the end we get all combinations of subsets where any particular s-item-i appared and all
+ ;; combinations of subsets where s-item-i did not appear.
(test-begin "2.32")
+ (test-equal
+ '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))
+ (subsets '(1 2 3)))
(test-end "2.32"))
(exercise-2.32)
+
+(define (enumerate-interval low high)
+ (if (> low high)
+ '()
+ (cons low
+ (enumerate-interval (1+ low)
+ high))))
+
+(test-begin "enumerate-interval")
+(test-equal
+ '()
+ (enumerate-interval 1 0))
+(test-equal
+ '(1)
+ (enumerate-interval 1 1))
+(test-equal
+ '(1 2)
+ (enumerate-interval 1 2))
+(test-equal
+ '(1 2 3)
+ (enumerate-interval 1 3))
+(test-end "enumerate-interval")
+
+(define (accumulate op initial sequence)
+ (if (null? sequence)
+ initial
+ (op (car sequence)
+ (accumulate op
+ initial
+ (cdr sequence)))))
+
+(test-begin "accumulate")
+(test-equal
+ 15
+ (accumulate + 0 '(1 2 3 4 5)))
+(test-equal
+ 120
+ (accumulate * 1 '(1 2 3 4 5)))
+(test-equal
+ '(1 2 3 4 5)
+ (accumulate cons '() '(1 2 3 4 5)))
+(test-end "accumulate")
+
+;; Exercise 2.33
+
+(define (exercise-2.33)
+ (define (map-2.33 p sequence)
+ (accumulate (lambda (x y)
+ (cons (p x)
+ y))
+ '()
+ sequence))
+
+ (define (append-2.33 seq1 seq2)
+ (accumulate cons
+ seq2
+ seq1))
+
+ (define (length-2.33 sequence)
+ (accumulate (lambda (x y) (1+ y))
+ 0
+ sequence))
+
+ (test-begin "2.33")
+ (test-equal
+ '(1 4 9 16 25 36)
+ (map-2.33 (lambda (x) (* x x))
+ (enumerate-interval 1 6)))
+ (test-equal
+ '(1 2 3 4 5 6)
+ (append-2.33 '(1 2 3)
+ '(4 5 6)))
+ (test-equal
+ 10
+ (length-2.33 '(1 2 3 4 5 6 7 8 9 10)))
+ (test-end "2.33"))
+
+(exercise-2.33)
+
+;; Exercise 2.34
+
+(define (exercise-2.34)
+ (define (horner-eval x coefficient-sequence)
+ (accumulate
+ (lambda (this-coeff higher-terms)
+ (+ (* higher-terms
+ x)
+ this-coeff))
+ 0
+ coefficient-sequence))
+
+ (test-begin "2.34")
+ (test-equal
+ (let ([x 2])
+ (+ (* 1) ; a_0
+ (* 3 x) ; a_1
+ (* 0 x x) ; a_2
+ (* 5 x x x) ; a_3
+ (* 0 x x x x) ; a_4
+ (* 1 x x x x x) ; a_5
+ ))
+ (horner-eval 2 '(1 3 0 5 0 1)))
+ (test-end "2.34"))
+
+(exercise-2.34)
+
+(define (exercise-2.35)
+ (define (count-leaves-2.2.2 tree)
+ (cond
+ ((null? tree) 0)
+ ((not (pair? tree)) 1)
+ (else (+ (count-leaves (car tree))
+ (count-leaves (cdr tree))))))
+
+ (define (count-leaves t)
+ (accumulate
+ +
+ 0
+ (map (lambda (x)
+ (if (pair? x)
+ (count-leaves x)
+ 1))
+ t)))
+
+ (define t '((1 2 3)
+ (3 (4 5 6)
+ (2 3))))
+
+ (test-begin "2.35")
+ (test-equal
+ (count-leaves-2.2.2 t)
+ (count-leaves t))
+ (test-end "2.35"))
+
+(exercise-2.35)
+
+;; Exercise 2.36
+
+(define (exercise-2.36)
+ (define (accumulate-n op init seqs)
+ (if (null? (car seqs))
+ '()
+ (cons (accumulate op
+ init
+ (map (lambda (x) (car x))
+ seqs))
+ (accumulate-n op
+ init
+ (map (lambda (x) (cdr x))
+ seqs)))))
+
+ (test-begin "2.36")
+ (test-equal
+ '(22 26 30)
+ (accumulate-n + 0 '((1 2 3)
+ (4 5 6)
+ (7 8 9)
+ (10 11 12))))
+ (test-end "2.36"))
+
+(exercise-2.36)
