commit fda464d7ccb2728447d1e2bd68b91301b3eddec0 parent 42088ed56594d583ec08f0f2bf9397e2a6b83b2d Author: Yuval Langer <yuval.langer@gmail.com> Date: Wed, 29 Mar 2023 20:03:11 +0300 Add solutions to exercise 2.70 and exercise 2.71 and rename everything to replace dots with underscores. Diffstat:
98 files changed, 694 insertions(+), 553 deletions(-)
diff --git a/Makefile b/Makefile @@ -2,10 +2,7 @@ poop: echo poop 2.70: - guile -l sicp/utils.scm -l sicp/solutions/exercise-1.21.scm -l sicp/solutions/exercise-2.40.scm -l sicp/solutions/huffman-codes-stuff.scm sicp/tests/2.70.scm + guile -L . sicp/tests/2_70.scm -tests: guile.scm - guile --no-auto-compile guile.scm - -full: guile.scm - guile --no-auto-compile guile.scm -- --full +2.71: + guile -L . sicp/tests/2_71.scm diff --git a/sicp/solutions/1_1.scm b/sicp/solutions/1_1.scm @@ -0,0 +1,26 @@ +(define-library (sicp solutions 1_1) + (import (scheme base)) + (import (srfi srfi-64)) + (export sum-of-squares) + + (begin + (define a 3) + + ;; nothing + + (define b (+ a 1)) + + ;; nothing + + + (define (square a) + (* a a)) + + ;; nothing + + (define (sum-of-squares a b) + (+ (square a) + (square b))) + + ;; nothing +)) diff --git a/sicp/solutions/exercise-1.10.scm b/sicp/solutions/1_10.scm diff --git a/sicp/solutions/exercise-1.11.scm b/sicp/solutions/1_11.scm diff --git a/sicp/solutions/exercise-1.12.scm b/sicp/solutions/1_12.scm diff --git a/sicp/solutions/exercise-1.13.scm b/sicp/solutions/1_13.scm diff --git a/sicp/solutions/exercise-1.14.scm b/sicp/solutions/1_14.scm diff --git a/sicp/solutions/exercise-1.16.scm b/sicp/solutions/1_16.scm diff --git a/sicp/solutions/exercise-1.17.scm b/sicp/solutions/1_17.scm diff --git a/sicp/solutions/exercise-1.18.scm b/sicp/solutions/1_18.scm diff --git a/sicp/solutions/exercise-1.19.scm b/sicp/solutions/1_19.scm diff --git a/sicp/solutions/exercise-1.2.scm b/sicp/solutions/1_2.scm diff --git a/sicp/solutions/exercise-1.20.scm b/sicp/solutions/1_20.scm diff --git a/sicp/solutions/1_21.scm b/sicp/solutions/1_21.scm @@ -0,0 +1,58 @@ +(define-library (sicp solutions 1_21) + (import (scheme base)) + (import (srfi srfi-1)) + (import (srfi srfi-64)) + (import (only (guile) random)) + (export prime? expmod fast-prime? smallest-divisor divides?) + + ;; XXX + + (begin + (define (smallest-divisor n) + (find-divisor n 2)) + + (define (find-divisor n test-divisor) + (cond + ((> (square test-divisor) n) + n) + + ((divides? test-divisor n) + test-divisor) + + (else (find-divisor n (+ 1 test-divisor))))) + + (define (divides? a b) + (= (remainder b a) 0)) + + (define (prime? n) + (= n (smallest-divisor n))) + + (define (expmod base exp m) + (cond + ((= exp 0) 1) + ((even? exp) + (remainder + (square (expmod base + (/ exp 2) + m)) + m)) + (else + (remainder + (* base + (expmod base + (- exp 1) + m)) + m)))) + + (define (fermat-test n) + (define (try-it a) + (= (expmod a n n) + a)) + (try-it (+ 1 (random (- n 1))))) + + (define (fast-prime? n times) + (cond + ((zero? times) #t) + ((fermat-test n) + (fast-prime? n (- times 1))) + (else #f))))) diff --git a/sicp/solutions/exercise-1.22.scm b/sicp/solutions/1_22.scm diff --git a/sicp/solutions/exercise-1.23.scm b/sicp/solutions/1_23.scm diff --git a/sicp/solutions/exercise-1.24.scm b/sicp/solutions/1_24.scm diff --git a/sicp/solutions/1_3.scm b/sicp/solutions/1_3.scm @@ -0,0 +1,25 @@ +(define-library (sicp solutions 1_3) + (import (scheme base)) + (import (srfi srfi-64)) + (import (only (sicp solutions 1_1) + sum-of-squares)) + (export sum-of-squares-of-two-largest-out-of-three) + + (begin + + #! + + *Exercise 1.3:* Define a procedure that takes three numbers as + arguments and returns the sum of the squares of the two larger + numbers. + + !# + + (define (sum-of-squares-of-two-largest-out-of-three a b c) + (if (< a b) + (if (< c a) + (sum-of-squares a b) + (sum-of-squares c b)) + (if (< c b) + (sum-of-squares b a) + (sum-of-squares c a)))))) diff --git a/sicp/solutions/1_4.scm b/sicp/solutions/1_4.scm @@ -0,0 +1,27 @@ +(define-library (sicp solutions exercise-1.4) + (import (scheme base)) + (import (srfi srfi-64)) + + + (begin + (define (a-plus-abs-b a b) + ((if (> b 0) + -) a b)) + + ;; The result of the "if" expression will be either the procedure "+" or + ;; the procedure "-", which is then applied to "a" and "b". + + + (test-begin "1.4") + (test-equal + (+ 2 3) + (a-plus-abs-b 2 3)) + (test-equal + (+ -2 3) + (a-plus-abs-b -2 3)) + (test-equal + (- 2 -3) + (a-plus-abs-b 2 -3)) + (test-equal + (- -2 -3) + (a-plus-abs-b -2 -3)) + (test-end "1.4"))) diff --git a/sicp/solutions/exercise-1.5.scm b/sicp/solutions/1_5.scm diff --git a/sicp/solutions/exercise-1.6.scm b/sicp/solutions/1_6.scm diff --git a/sicp/solutions/1_7.scm b/sicp/solutions/1_7.scm @@ -0,0 +1,54 @@ +(define-library (sicp solutions 1_7) + (import (scheme base)) + (import (scheme write)) + + (begin + #! + + *Exercise 1.7:* The `good-enough?' test used in computing square + roots will not be very effective for finding the square roots of + very small numbers. Also, in real computers, arithmetic operations + are almost always performed with limited precision. This makes + our test inadequate for very large numbers. Explain these + statements, with examples showing how the test fails for small and + large numbers. An alternative strategy for implementing + `good-enough?' is to watch how `guess' changes from one iteration + to the next and to stop when the change is a very small fraction + of the guess. Design a square-root procedure that uses this kind + of end test. Does this work better for small and large numbers? + + !# + + + (define (square-root x) + (define (average a b) + (/ (+ a b) 2)) + + (define (improve guess x) + ;; (dp guess x) + (average guess (/ x guess))) + + (define (good-enough? old-guess new-guess) + (define bound 0.0000000000001) + (define ratio (/ old-guess new-guess)) + + (define within-bounds + (< (- 1 bound) ratio (+ 1 bound))) + + ;; (dp bound ratio within-bounds) + + within-bounds) + + (define (square-root-iter guess x) + (define new-guess (improve guess x)) + ;; (dp new-guess) + + (if (good-enough? guess new-guess) + guess + (square-root-iter new-guess + x))) + + (square-root-iter 1 x)) + + (write (square-root 0.000000000001)) (newline) + (write (square-root (/ 1 0.000000000001))) (newline))) diff --git a/sicp/solutions/exercise-1.8.scm b/sicp/solutions/1_8.scm diff --git a/sicp/solutions/exercise-1.9.scm b/sicp/solutions/1_9.scm diff --git a/sicp/solutions/exercise-2.1.scm b/sicp/solutions/2_1.scm diff --git a/sicp/solutions/exercise-2.17.scm b/sicp/solutions/2_17.scm diff --git a/sicp/solutions/exercise-2.18.scm b/sicp/solutions/2_18.scm diff --git a/sicp/solutions/exercise-2.19.scm b/sicp/solutions/2_19.scm diff --git a/sicp/solutions/exercise-2.2.scm b/sicp/solutions/2_2.scm diff --git a/sicp/solutions/exercise-2.20.scm b/sicp/solutions/2_20.scm diff --git a/sicp/solutions/exercise-2.21.scm b/sicp/solutions/2_21.scm diff --git a/sicp/solutions/exercise-2.22.scm b/sicp/solutions/2_22.scm diff --git a/sicp/solutions/exercise-2.23.scm b/sicp/solutions/2_23.scm diff --git a/sicp/solutions/exercise-2.24.scm b/sicp/solutions/2_24.scm diff --git a/sicp/solutions/exercise-2.25.scm b/sicp/solutions/2_25.scm diff --git a/sicp/solutions/exercise-2.26.scm b/sicp/solutions/2_26.scm diff --git a/sicp/solutions/exercise-2.27.scm b/sicp/solutions/2_27.scm diff --git a/sicp/solutions/exercise-2.28.scm b/sicp/solutions/2_28.scm diff --git a/sicp/solutions/exercise-2.29.scm b/sicp/solutions/2_29.scm diff --git a/sicp/solutions/exercise-2.3.scm b/sicp/solutions/2_3.scm diff --git a/sicp/solutions/exercise-2.30.scm b/sicp/solutions/2_30.scm diff --git a/sicp/solutions/exercise-2.31.scm b/sicp/solutions/2_31.scm diff --git a/sicp/solutions/exercise-2.32.scm b/sicp/solutions/2_32.scm diff --git a/sicp/solutions/2_33.scm b/sicp/solutions/2_33.scm @@ -0,0 +1,40 @@ +(define-library (sicp solutions exercise-2.33) + (import (scheme base)) + (import (utils)) + (export map-2.33 append-2.33 length-2.33) + + (begin + (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)) + + + (define (map p sequence) + (accumulate (lambda (x y) + (cons (p x) + y)) + '() + sequence)) + + (define (append seq1 seq2) + (accumulate cons + seq2 + seq1)) + + (define (length sequence) + (accumulate (lambda (x y) (+ 1 y)) + 0 + sequence)))) diff --git a/sicp/solutions/2_34.scm b/sicp/solutions/2_34.scm @@ -0,0 +1,14 @@ +(define-library (sicp solutions exercise-2.34) + (import (scheme base)) + (import (utils)) + (export horner-eval) + + (begin + (define (horner-eval x coefficient-sequence) + (accumulate + (lambda (this-coeff higher-terms) + (+ (* higher-terms + x) + this-coeff)) + 0 + coefficient-sequence)))) diff --git a/sicp/solutions/2_35.scm b/sicp/solutions/2_35.scm @@ -0,0 +1,22 @@ +(define-library (sicp solutions exercise-2.35) + (import (scheme base)) + (import (sicp utils)) + (export count-leaves count-leaves-2.2.2) + + (begin + (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))))) diff --git a/sicp/solutions/2_36.scm b/sicp/solutions/2_36.scm @@ -0,0 +1,18 @@ +(define-library (sicp solutions exercise-2.36) + (import (scheme base)) + (import (sicp utils)) + (export accumulate-n) + + (begin + (define (accumulate-n op init seqs) + ;; Took it out of exercise-2.36 because we'll need it later in 2.37. + (if (null? (car seqs)) + '() + (cons (accumulate op + init + (map (lambda (x) (car x)) + seqs)) + (accumulate-n op + init + (map (lambda (x) (cdr x)) + seqs))))))) diff --git a/sicp/solutions/exercise-2.37.scm b/sicp/solutions/2_37.scm diff --git a/sicp/solutions/exercise-2.38.scm b/sicp/solutions/2_38.scm diff --git a/sicp/solutions/exercise-2.39.scm b/sicp/solutions/2_39.scm diff --git a/sicp/solutions/exercise-2.4.scm b/sicp/solutions/2_4.scm diff --git a/sicp/solutions/2_40.scm b/sicp/solutions/2_40.scm @@ -0,0 +1,75 @@ +(define-library (sicp solutions 2_40) + (import (scheme base)) + (import (only (sicp utils) + accumulate + enumerate-interval + filter + flatmap)) + (import (only (sicp solutions 1_21) prime?)) + (export my-prime-sum-pairs + prime-sum-pairs + remove + unique-pairs) + + (begin + (define (unique-pairs n) + (flatmap (lambda (i) + (map (lambda (j) + (list i j)) + (enumerate-interval 1 (- i 1)))) + (enumerate-interval 1 n))) + + (define (remove item sequence) + (filter (lambda (x) + (not (equal? x + item))) + sequence)) + + (define (permutations s) + (if (null? s) + (list '()) + (flatmap (lambda (x) + (map (lambda (p) + (cons x p)) + (permutations (remove x + s)))) + s))) + + (define (f n) + (accumulate + append + '() + (map (lambda (i) + (map (lambda (j) + (list i j)) + (enumerate-interval 1 (- i 1)))) + (enumerate-interval 1 n)))) + + (define (g n) + (flatmap (lambda (x) x) (enumerate-interval 1 n))) + + (define (prime-sum? pair) + (prime? (+ (car pair) + (cadr pair)))) + + (define (make-pair-sum pair) + (list (car pair) + (cadr pair) + (+ (car pair) + (cadr pair)))) + + (define (prime-sum-pairs n) + (map make-pair-sum + (filter + prime-sum? + (flatmap + (lambda (i) + (map (lambda (j) + (list i j)) + (enumerate-interval 1 (- i 1)))) + (enumerate-interval 1 n))))) + + (define (my-prime-sum-pairs n) + (map make-pair-sum + (filter prime-sum? + (unique-pairs n)))))) diff --git a/sicp/solutions/exercise-2.41.scm b/sicp/solutions/2_41.scm diff --git a/sicp/solutions/exercise-2.42.scm b/sicp/solutions/2_42.scm diff --git a/sicp/solutions/exercise-2.5.scm b/sicp/solutions/2_5.scm diff --git a/sicp/solutions/exercise-2.53.scm b/sicp/solutions/2_53.scm diff --git a/sicp/solutions/exercise-2.54.scm b/sicp/solutions/2_54.scm diff --git a/sicp/solutions/exercise-2.55.scm b/sicp/solutions/2_55.scm diff --git a/sicp/solutions/exercise-2.56.scm b/sicp/solutions/2_56.scm diff --git a/sicp/solutions/exercise-2.59.scm b/sicp/solutions/2_59.scm diff --git a/sicp/solutions/exercise-2.6.scm b/sicp/solutions/2_6.scm diff --git a/sicp/solutions/exercise-2.60.scm b/sicp/solutions/2_60.scm diff --git a/sicp/solutions/exercise-2.61-2.62.scm b/sicp/solutions/2_61-2_62.scm diff --git a/sicp/solutions/exercise-2.64.scm b/sicp/solutions/2_64.scm diff --git a/sicp/solutions/exercise-2.7.scm b/sicp/solutions/2_7.scm diff --git a/sicp/solutions/exercise-1.1.scm b/sicp/solutions/exercise-1.1.scm @@ -1,88 +0,0 @@ -(define-library (sicp solutions exercise-1.1) - (import (scheme base)) - (import (srfi srfi-64)) - (export sum-of-squares) - - (begin - 10 - - (test-begin "1.1") - - (test-equal 10 10) - - (test-equal - (+ 5 3 4) - - 12) - - (test-equal - (- 9 1) - - 8) - - (test-equal - (/ 6 2) - - 3) - - (test-equal - (+ (* 2 4) (- 4 6)) - - 6) - - (define a 3) - - ;; nothing - - (define b (+ a 1)) - - ;; nothing - - (test-equal - (+ a b (* a b)) - - 19) - - (test-equal - (= a b) - - #f) - - (test-equal - (if (and (> b a) (< b (* a b))) - b - a) - - 4) - - (test-equal - (cond ((= a 4) 6) - ((= b 4) (+ 6 7 a)) - (else 25)) - - 16) - - (test-equal - (+ 2 (if (> b a) b a)) - - 6) - - (test-equal - (* (cond ((> a b) a) - ((< a b) b) - (else -1)) - (+ a 1)) - 16) - - (define (square a) - (* a a)) - - ;; nothing - - (define (sum-of-squares a b) - (+ (square a) - (square b))) - - ;; nothing - - (test-end "1.1"))) diff --git a/sicp/solutions/exercise-1.21.scm b/sicp/solutions/exercise-1.21.scm @@ -1,58 +0,0 @@ -(define-library (sicp solutions exercise-1.21) - (import (scheme base)) - (import (srfi srfi-1)) - (import (srfi srfi-64)) - (import (only (guile) random)) - (export prime? expmod fast-prime? smallest-divisor divides?) - - ;; XXX - - (begin - (define (smallest-divisor n) - (find-divisor n 2)) - - (define (find-divisor n test-divisor) - (cond - ((> (square test-divisor) n) - n) - - ((divides? test-divisor n) - test-divisor) - - (else (find-divisor n (+ 1 test-divisor))))) - - (define (divides? a b) - (= (remainder b a) 0)) - - (define (prime? n) - (= n (smallest-divisor n))) - - (define (expmod base exp m) - (cond - ((= exp 0) 1) - ((even? exp) - (remainder - (square (expmod base - (/ exp 2) - m)) - m)) - (else - (remainder - (* base - (expmod base - (- exp 1) - m)) - m)))) - - (define (fermat-test n) - (define (try-it a) - (= (expmod a n n) - a)) - (try-it (+ 1 (random (- n 1))))) - - (define (fast-prime? n times) - (cond - ((zero? times) #t) - ((fermat-test n) - (fast-prime? n (- times 1))) - (else #f))))) diff --git a/sicp/solutions/exercise-1.3.scm b/sicp/solutions/exercise-1.3.scm @@ -1,34 +0,0 @@ -(define-library (sicp solutions exercise-1.3) - (import (scheme base)) - (import (srfi srfi-64)) - (import (guile-1.1)) - - (begin - - #! - - *Exercise 1.3:* Define a procedure that takes three numbers as - arguments and returns the sum of the squares of the two larger - numbers. - - !# - - - - (define (exercise-1-3 a b c) - (if (< a b) - (if (< c a) - (sum-of-squares a b) - (sum-of-squares c b)) - (if (< c b) - (sum-of-squares b a) - (sum-of-squares c a)))) - - (test-begin "1.3") - (test-equal (exercise-1-3 2 3 5) 34) - (test-equal (exercise-1-3 2 5 3) 34) - (test-equal (exercise-1-3 3 2 5) 34) - (test-equal (exercise-1-3 3 5 2) 34) - (test-equal (exercise-1-3 5 2 3) 34) - (test-equal (exercise-1-3 5 3 2) 34) - (test-end "1.3"))) diff --git a/sicp/solutions/exercise-1.4.scm b/sicp/solutions/exercise-1.4.scm @@ -1,27 +0,0 @@ -(define-library (sicp solutions exercise-1.4) - (import (scheme base)) - (import (srfi srfi-64)) - - - (begin - (define (a-plus-abs-b a b) - ((if (> b 0) + -) a b)) - - ;; The result of the "if" expression will be either the procedure "+" or - ;; the procedure "-", which is then applied to "a" and "b". - - - (test-begin "1.4") - (test-equal - (+ 2 3) - (a-plus-abs-b 2 3)) - (test-equal - (+ -2 3) - (a-plus-abs-b -2 3)) - (test-equal - (- 2 -3) - (a-plus-abs-b 2 -3)) - (test-equal - (- -2 -3) - (a-plus-abs-b -2 -3)) - (test-end "1.4"))) diff --git a/sicp/solutions/exercise-1.7.scm b/sicp/solutions/exercise-1.7.scm @@ -1,50 +0,0 @@ - -#! - -*Exercise 1.7:* The `good-enough?' test used in computing square -roots will not be very effective for finding the square roots of -very small numbers. Also, in real computers, arithmetic operations -are almost always performed with limited precision. This makes -our test inadequate for very large numbers. Explain these -statements, with examples showing how the test fails for small and -large numbers. An alternative strategy for implementing -`good-enough?' is to watch how `guess' changes from one iteration -to the next and to stop when the change is a very small fraction -of the guess. Design a square-root procedure that uses this kind -of end test. Does this work better for small and large numbers? - -!# - - -(define (square-root x) - (define (average a b) - (/ (+ a b) 2)) - - (define (improve guess x) - ;; (dp guess x) - (average guess (/ x guess))) - - (define (good-enough? old-guess new-guess) - (define bound 0.0000000000001) - (define ratio (/ old-guess new-guess)) - - (define within-bounds - (< (- 1 bound) ratio (+ 1 bound))) - - ;; (dp bound ratio within-bounds) - - within-bounds) - - (define (square-root-iter guess x) - (define new-guess (improve guess x)) - ;; (dp new-guess) - - (if (good-enough? guess new-guess) - guess - (square-root-iter new-guess - x))) - - (square-root-iter 1 x)) - -(format #t "~f\n" (square-root 0.000000000001)) -(format #t "~f\n" (square-root (/ 1 0.000000000001))) diff --git a/sicp/solutions/exercise-2.33.scm b/sicp/solutions/exercise-2.33.scm @@ -1,40 +0,0 @@ -(define-library (sicp solutions exercise-2.33) - (import (scheme base)) - (import (utils)) - (export map-2.33 append-2.33 length-2.33) - - (begin - (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)) - - - (define (map p sequence) - (accumulate (lambda (x y) - (cons (p x) - y)) - '() - sequence)) - - (define (append seq1 seq2) - (accumulate cons - seq2 - seq1)) - - (define (length sequence) - (accumulate (lambda (x y) (+ 1 y)) - 0 - sequence)))) diff --git a/sicp/solutions/exercise-2.34.scm b/sicp/solutions/exercise-2.34.scm @@ -1,14 +0,0 @@ -(define-library (sicp solutions exercise-2.34) - (import (scheme base)) - (import (utils)) - (export horner-eval) - - (begin - (define (horner-eval x coefficient-sequence) - (accumulate - (lambda (this-coeff higher-terms) - (+ (* higher-terms - x) - this-coeff)) - 0 - coefficient-sequence)))) diff --git a/sicp/solutions/exercise-2.35.scm b/sicp/solutions/exercise-2.35.scm @@ -1,22 +0,0 @@ -(define-library (sicp solutions exercise-2.35) - (import (scheme base)) - (import (sicp utils)) - (export count-leaves count-leaves-2.2.2) - - (begin - (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))))) diff --git a/sicp/solutions/exercise-2.36.scm b/sicp/solutions/exercise-2.36.scm @@ -1,18 +0,0 @@ -(define-library (sicp solutions exercise-2.36) - (import (scheme base)) - (import (sicp utils)) - (export accumulate-n) - - (begin - (define (accumulate-n op init seqs) - ;; Took it out of exercise-2.36 because we'll need it later in 2.37. - (if (null? (car seqs)) - '() - (cons (accumulate op - init - (map (lambda (x) (car x)) - seqs)) - (accumulate-n op - init - (map (lambda (x) (cdr x)) - seqs))))))) diff --git a/sicp/solutions/exercise-2.40.scm b/sicp/solutions/exercise-2.40.scm @@ -1,71 +0,0 @@ -(define-library (sicp solutions exercise-2.40) - (import (scheme base)) - (import (only (sicp utils) filter)) - (import (only (sicp solutions exercise-1.21) prime?)) - (export my-prime-sum-pairs - prime-sum-pairs - remove - unique-pairs) - - (begin - (define (unique-pairs n) - (flatmap (lambda (i) - (map (lambda (j) - (list i j)) - (enumerate-interval 1 (- i 1)))) - (enumerate-interval 1 n))) - - (define (remove item sequence) - (filter (lambda (x) - (not (equal? x - item))) - sequence)) - - (define (permutations s) - (if (null? s) - (list '()) - (flatmap (lambda (x) - (map (lambda (p) - (cons x p)) - (permutations (remove x - s)))) - s))) - - (define (f n) - (accumulate - append - '() - (map (lambda (i) - (map (lambda (j) - (list i j)) - (enumerate-interval 1 (- i 1)))) - (enumerate-interval 1 n)))) - - (define (g n) - (flatmap (lambda (x) x) (enumerate-interval 1 n))) - - (define (prime-sum? pair) - (prime? (+ (car pair) - (cadr pair)))) - - (define (make-pair-sum pair) - (list (car pair) - (cadr pair) - (+ (car pair) - (cadr pair)))) - - (define (prime-sum-pairs n) - (map make-pair-sum - (filter - prime-sum? - (flatmap - (lambda (i) - (map (lambda (j) - (list i j)) - (enumerate-interval 1 (- i 1)))) - (enumerate-interval 1 n))))) - - (define (my-prime-sum-pairs n) - (map make-pair-sum - (filter prime-sum? - (unique-pairs n)))))) diff --git a/sicp/solutions/huffman-codes-stuff.scm b/sicp/solutions/huffman-codes-stuff.scm @@ -4,7 +4,7 @@ (import (scheme write)) (import (scheme cxr)) (import (only (sicp utils) accumulate)) - (import (only (sicp solutions exercise-2.40) remove)) + (import (only (sicp solutions 2_40) remove)) (export decode encode generate-huffman-tree diff --git a/sicp/solutions/tree-stuff.scm b/sicp/solutions/tree-stuff.scm @@ -1,6 +1,6 @@ (define-library (trees-stuff) (import (scheme base)) - + (begin (define (entry tree) (car tree)) (define (left-branch tree) (cadr tree)) @@ -63,7 +63,7 @@ (make-tree 11 '() '())))) ;; Exercise 2.63 XXX - + (test-begin "2.63") ;; These tests show that the algorithms are the same for the three input trees. Sadly, I wouldn't know how to prove mathematical equivalency. @@ -76,7 +76,7 @@ (test-equal (tree->list-1 tree-3) (tree->list-2 tree-3)) - + ;; tree->list-1 uses append for each pair of branches, so for level 1 we have ;; 1 append, for level 2 we have 2 appends, level 3 has 4 appends. ;; For an input of length n, an append has n steps, so for level 1 we append @@ -374,9 +374,9 @@ '()))))))) (test-end "2.63") - + ;; Exercise 2.64 XXX - + (define (list->tree elements) (car (partial-tree elements @@ -410,7 +410,7 @@ left-tree right-tree) remaining-elts)))))))) - + (test-begin "2.64") (test-equal (make-tree 1 '() '()) @@ -476,13 +476,13 @@ (define (make-entry key value) (cons key value)) - + (define (key entry) (car entry)) (define (value entry) (cdr entry)) - + (define (lookup given-key set-of-records) (cond ((null? set-of-records) #f) diff --git a/sicp/tests/1_1.scm b/sicp/tests/1_1.scm @@ -0,0 +1,62 @@ +(import (srfi :1)) + +(test-begin "1.1") + +(test-equal 10 10) + +(test-equal + (+ 5 3 4) + + 12) + +(test-equal + (- 9 1) + + 8) + +(test-equal + (/ 6 2) + + 3) + +(test-equal + (+ (* 2 4) (- 4 6)) + + 6) + +(test-equal + (+ a b (* a b)) + + 19) + +(test-equal + (= a b) + + #f) + +(test-equal + (if (and (> b a) (< b (* a b))) + b + a) + + 4) + +(test-equal + (cond ((= a 4) 6) + ((= b 4) (+ 6 7 a)) + (else 25)) + + 16) + +(test-equal + (+ 2 (if (> b a) b a)) + + 6) + +(test-equal + (* (cond ((> a b) a) + ((< a b) b) + (else -1)) + (+ a 1)) + 16) +(test-end "1.1") diff --git a/sicp/tests/exercise-1.21-tests.scm b/sicp/tests/1_21.scm diff --git a/sicp/tests/1_3.scm b/sicp/tests/1_3.scm @@ -0,0 +1,11 @@ +(import (srfi :64)) +(import (only (sicp solutions 1_3) sum-of-squares-of-two-largest-out-of-three)) + +(test-begin "1.3") +(test-equal (sum-of-squares-of-two-largest-out-of-three 2 3 5) 34) +(test-equal (sum-of-squares-of-two-largest-out-of-three 2 5 3) 34) +(test-equal (sum-of-squares-of-two-largest-out-of-three 3 2 5) 34) +(test-equal (sum-of-squares-of-two-largest-out-of-three 3 5 2) 34) +(test-equal (sum-of-squares-of-two-largest-out-of-three 5 2 3) 34) +(test-equal (sum-of-squares-of-two-largest-out-of-three 5 3 2) 34) +(test-end "1.3") diff --git a/sicp/tests/2.70.scm b/sicp/tests/2.70.scm @@ -1,84 +0,0 @@ -(import (srfi :26)) -(import (srfi :64)) -(import (only (sicp utils) accumulate)) -(import (only (sicp solutions huffman-codes-stuff) - decode - encode - generate-huffman-tree - weight - make-leaf)) - -(define (remove-empty-strings list-of-strings) - (filter (compose not - (cut equal? - "" - <>)) - list-of-strings)) - -(define code-text - "A 2 NA 16 -BOOM 1 SHA 3 -GET 2 YIP 9 -JOB 2 WAH 1") - -(define songs-huffman-tree - (let* ([split-code-text - (string-split code-text - (string->char-set "\n "))] - [only-tokens-code-text - (remove-empty-strings split-code-text)] - [list-of-pairs (let loop ([code-list only-tokens-code-text]) - (cond - ((null? code-list) '()) - ((null? (cdr code-list)) '()) - (else (cons (list (string->symbol (car code-list)) - (string->number (cadr code-list))) - (loop (cddr code-list))))))] - [ordered-pairs-by-weight (sort list-of-pairs - (lambda (x y) - (< (cadr x) - (cadr y))))]) - (generate-huffman-tree ordered-pairs-by-weight))) - -(define song-text - "Get a job -Sha na na na na na na na na - -Get a job -Sha na na na na na na na na - -Wah yip yip yip yip -yip yip yip yip yip -Sha boom") - -(define only-letters-song-message - (remove-empty-strings - (string-split (string-upcase song-text) - (string->char-set "\n ")))) - -(define song-message - (map string->symbol only-letters-song-message)) - -(define encoded-song-message - (encode song-message - songs-huffman-tree)) - -(test-begin "2.70") -(test-equal - 84 - (length encoded-song-message)) -(test-equal - 992 - (* 8 ;; Length of message in bits is a 8 bits per byte times length of message in characters. - (apply + ;; length of message in characters - (cons ;; is length of spaces - (- (length only-letters-song-message) ;; which is the length of message in symbols - 1) ;; minus one to get the number of spaces between symbols - (map string-length - only-letters-song-message))))) ;; plus the number of characters in each symbol. -(test-end "2.70") - -;; We count consecutive whitespaces - newline and a spacey space - as a single -;; space delimiting the symbols. -;; We also disregard letter case and casing, which is unadvised for a -;; reasonably safe journey in the land of languages. diff --git a/sicp/tests/2_33.scm b/sicp/tests/2_33.scm @@ -0,0 +1,17 @@ +(import (srfi :64)) +(import (utils)) +(import (solutions exercise-2.33)) + +(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") diff --git a/sicp/tests/exercise-2.34-tests.scm b/sicp/tests/2_34.scm diff --git a/sicp/tests/exercise-2.35-tests.scm b/sicp/tests/2_35.scm diff --git a/sicp/tests/exercise-2.36-tests.scm b/sicp/tests/2_36.scm diff --git a/sicp/tests/2_40.scm b/sicp/tests/2_40.scm @@ -0,0 +1,14 @@ +(import (srfi :64)) +(import (sicp solutions 2_40)) + + +(test-begin "2.40") +(test-equal + '((2 1) + (3 1) (3 2) + (4 1) (4 2) (4 3)) + (unique-pairs 4)) +(test-equal + (prime-sum-pairs 20) + (my-prime-sum-pairs 20)) +(test-end "2.40") diff --git a/sicp/tests/exercise-2.41-tests.scm b/sicp/tests/2_41.scm diff --git a/sicp/tests/exercise-2.42-tests.scm b/sicp/tests/2_42.scm diff --git a/sicp/tests/exercise-2.61-tests.scm b/sicp/tests/2_61.scm diff --git a/sicp/tests/exercise-2.62-tests.scm b/sicp/tests/2_62.scm diff --git a/sicp/tests/exercise-2.67-tests.scm b/sicp/tests/2_67.scm diff --git a/sicp/tests/exercise-2.68-tests.scm b/sicp/tests/2_68.scm diff --git a/sicp/tests/exercise-2.69-tests.scm b/sicp/tests/2_69.scm diff --git a/sicp/tests/2_70.scm b/sicp/tests/2_70.scm @@ -0,0 +1,85 @@ +(import (only (srfi :1) zip)) +(import (srfi :26)) +(import (srfi :64)) +(import (only (sicp utils) accumulate)) +(import (only (sicp solutions huffman-codes-stuff) + decode + encode + generate-huffman-tree + weight + make-leaf)) + +(define (remove-empty-strings list-of-strings) + (filter (compose not + (cut equal? + "" + <>)) + list-of-strings)) + +(define code-text + "A 2 NA 16 +BOOM 1 SHA 3 +GET 2 YIP 9 +JOB 2 WAH 1") + +(define songs-huffman-tree + (let* ([split-code-text + (string-split code-text + (string->char-set "\n "))] + [only-tokens-code-text + (remove-empty-strings split-code-text)] + [list-of-pairs (let loop ([code-list only-tokens-code-text]) + (cond + ((null? code-list) '()) + ((null? (cdr code-list)) '()) + (else (cons (list (string->symbol (car code-list)) + (string->number (cadr code-list))) + (loop (cddr code-list))))))] + [ordered-pairs-by-weight (sort list-of-pairs + (lambda (x y) + (< (cadr x) + (cadr y))))]) + (generate-huffman-tree ordered-pairs-by-weight))) + +(define song-text + "Get a job +Sha na na na na na na na na + +Get a job +Sha na na na na na na na na + +Wah yip yip yip yip +yip yip yip yip yip +Sha boom") + +(define only-letters-song-message + (remove-empty-strings + (string-split (string-upcase song-text) + (string->char-set "\n ")))) + +(define song-message + (map string->symbol only-letters-song-message)) + +(define encoded-song-message + (encode song-message + songs-huffman-tree)) + +(test-begin "2.70") +(test-equal + 84 + (length encoded-song-message)) +(test-equal + 992 + (* 8 ;; Length of message in bits is a 8 bits per byte times length of message in characters. + (apply + ;; length of message in characters + (cons ;; is length of spaces + (- (length only-letters-song-message) ;; which is the length of message in symbols + 1) ;; minus one to get the number of spaces between symbols + (map string-length + only-letters-song-message))))) ;; plus the number of characters in each symbol. +(test-end "2.70") + +;; We count consecutive whitespaces - newline and a spacey space - as a single +;; space delimiting the symbols. +;; We also disregard letter case and casing, which is unadvised for a +;; reasonably safe journey in the land of languages. diff --git a/sicp/tests/2_71.scm b/sicp/tests/2_71.scm @@ -0,0 +1,122 @@ +(import (only (srfi :1) zip)) +(import (srfi :26)) +(import (srfi :42)) +(import (srfi :64)) +(import (only (sicp solutions huffman-codes-stuff) + generate-huffman-tree + make-code-tree + make-leaf)) + +;; For n = 5 + +;; 1 2 3 4 5 +;; 0 1 2 3 4 +;; 1 2 4 8 16 (sum = 31) +;; A B C D E + +;; (A B C D E) 31 +;; / \ +;; E 16 \ +;; (A B C D) 15 +;; / \ +;; D 8 \ +;; (A B C) 7 +;; / \ +;; C 4 \ +;; (A B) 3 +;; / \ +;; B 2 A 1 + + +;; For n = 10 + +;; 1 2 3 4 5 6 7 8 9 10 +;; 0 1 2 3 4 5 6 7 8 9 +;; 1 2 4 8 16 32 64 128 256 512 (sum = 1023) +;; A B C D E F G H I J + +;; ({A 1} {B 2} {C 4} {D 8} {E 16} {F 32} {G 64} {H 128} {I 256} {J 512}) +;; ({A B 3} {C 4} {D 8} {E 16} {F 32} {G 64} {H 128} {I 256} {J 512}) +;; ({A B C 7} {D 8} {E 16} {F 32} {G 64} {H 128} {I 256} {J 512}) +;; ({A B C D 15} {E 16} {F 32} {G 64} {H 128} {I 256} {J 512}) +;; ({A B C D E 31} {F 32} {G 64} {H 128} {I 256} {J 512}) +;; ({A B C D E F 63} {G 64} {H 128} {I 256} {J 512}) +;; ({A B C D E F G 127} {H 128} {I 256} {J 512}) +;; ({A B C D E F G H 255} {I 256} {J 512}) +;; ({A B C D E F G H I 511} {J 512}) +;; ({A B C D E F G H I J 1023}) + +;; (A B C D E F G H I J) 1023 +;; / \ +;; J 512 \ +;; \ +;; (A B C D E F G H I) 511 +;; / \ +;; I 256 \ +;; \ +;; (A B C D E F G H) 255 +;; / \ +;; H 128 \ +;; \ +;; (A B C D E F G) 127 +;; / \ +;; G 64 \ +;; \ +;; (A B C D E F) 63 +;; / \ +;; F 32 \ +;; \ +;; (A B C D E) 31 +;; / \ +;; E 16 \ +;; (A B C D) 15 +;; / \ +;; D 8 \ +;; (A B C) 7 +;; / \ +;; C 4 \ +;; (A B) 3 +;; / \ +;; B 2 A 1 + +(test-begin "2.71") +(test-equal + (make-code-tree + (make-leaf 'E 16) + (make-code-tree + (make-leaf 'D 8) + (make-code-tree + (make-leaf 'C 4) + (make-code-tree + (make-leaf 'B 2) + (make-leaf 'A 1))))) + (generate-huffman-tree (zip '(A B C D E) + (map (cut expt 2 <>) + (iota 5 0))))) +(test-equal + (make-code-tree + (make-leaf 'J 512) + (make-code-tree + (make-leaf 'I 256) + (make-code-tree + (make-leaf 'H 128) + (make-code-tree + (make-leaf 'G 64) + (make-code-tree + (make-leaf 'F 32) + (make-code-tree + (make-leaf 'E 16) + (make-code-tree + (make-leaf 'D 8) + (make-code-tree + (make-leaf 'C 4) + (make-code-tree + (make-leaf 'B 2) + (make-leaf 'A 1)))))))))) + (generate-huffman-tree (zip '(A B C D E F G H I J) + (map (cut expt 2 <>) + (iota 10 0))))) +(test-end "2.71") + +;; For n encoded symbols, the most frequent symbol would need 1 bit and the +;; least frequent symbol would need (n - 1) bits. diff --git a/sicp/tests/2_72.scm b/sicp/tests/2_72.scm @@ -0,0 +1,12 @@ +;; Exercise 2.72 + +;; For n symbols, best case scenario would be 1 if we first look at the right +;; branch n-1 if we first look at the left branch. O(1) or O(n) running time +;; to encode the most frequent symbol. +;; +;; The worst case scenario would be: +;; n-1 (or 1 plus n-1 (n) if we first look at the left branch?) for the first lookup +;; n-2 (or 1 plus n-2 (n-1) if we first look at the left branch?) for the second. +;; ... +;; 1. (or 1 plus one (2) if we first look at the left branch?) +;; Which is O(n^2) running time, right, no? diff --git a/sicp/tests/exercise-2.33-tests.scm b/sicp/tests/exercise-2.33-tests.scm @@ -1,18 +0,0 @@ -(import (srfi :64)) -(import (utils)) -(import (solutions exercise-2.33)) - -(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") - diff --git a/sicp/tests/exercise-2.40-tests.scm b/sicp/tests/exercise-2.40-tests.scm @@ -1,14 +0,0 @@ -(import (srfi :64)) -(import (solutions exercise-2.40)) - - -(test-begin "2.40") -(test-equal - '((2 1) - (3 1) (3 2) - (4 1) (4 2) (4 3)) - (unique-pairs 4)) -(test-equal - (prime-sum-pairs 20) - (my-prime-sum-pairs 20)) -(test-end "2.40")