commit 3bc4c9e912695777cb17fa93fb2e1fd4f541deb7 parent 2d1e58224d4dd0d8ee91fc711691e470f8cbcd96 Author: Yuval Langer <yuval.langer@gmail.com> Date: Mon, 13 Nov 2023 23:42:36 +0200 Change file and library hierarchy. For each chapter x and exercise y, (sicp solutions chapter-x exercise-y) for solutions and (sicp tests chapter-x exercise-y) for tests. Diffstat:
220 files changed, 3032 insertions(+), 2663 deletions(-)
diff --git a/Makefile b/Makefile @@ -1,26 +1,16 @@ -poop: - echo poop +tests = $(wildcard sicp/tests/chapter-*/exercise-*.scm) +tests_results = $(foreach test,$(tests),$(shell dirname $(test) | sed 's#sicp/tests/##')-$(shell basename -s ".scm" $(test)).log) -statistics: - guile -L . sicp/statistics.scm - -3.8: - guile -L . sicp/tests/3_8.scm - -3.7: - guile -L . sicp/tests/3_7.scm +.PHONY: all +all: $(tests_results) -3.6: - guile -L . sicp/tests/3_6.scm +.PHONY: print_variables +print_variables: + printf "%s\n" $(tests) + printf "%s\n" $(tests_results) -2.75: - guile -L . sicp/tests/2_75.scm +$(tests_results): $(tests) + guile -L . `printf $@ | sed -E 's#(chapter-[0-9]*)-(exercise-[0-9]+).log#sicp/tests/\1/\2.scm#g'` -2.73: - guile -L . sicp/tests/2_73.scm - -2.70: - guile -L . sicp/tests/2_70.scm - -2.71: - guile -L . sicp/tests/2_71.scm +statistics: + guile -L . sicp/statistics.scm diff --git a/sicp/solutions/1_1.scm b/sicp/solutions/1_1.scm @@ -1,26 +0,0 @@ -(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/1_2.scm b/sicp/solutions/1_2.scm @@ -1,30 +0,0 @@ -(define-library (sicp solutions exercise-1.2) - (import (scheme base)) - (import (srfi srfi-64)) - - (begin - - #! - - *Exercise 1.2:* Translate the following expression into prefix - form. - - 5 + 4 + (2 - (3 - (6 + 4/5))) - ----------------------------- - 3(6 - 2)(2 - 7) - - !# - - (test-begin "1.2") - (test-equal - (/ (+ 5 - 4 - (- 2 - (- 3 - (+ 6 - (/ 4 5))))) - (* 3 - (- 6 2) - (- 2 7))) - (/ (- 37) 150)) - (test-end "1.2"))) diff --git a/sicp/solutions/1_21.scm b/sicp/solutions/1_21.scm @@ -1,64 +0,0 @@ -(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/1_3.scm b/sicp/solutions/1_3.scm @@ -1,25 +0,0 @@ -(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_30.scm b/sicp/solutions/1_30.scm @@ -1,26 +0,0 @@ -(define-library (sicp solutions 1_30) - (import (scheme base)) - (export - linear-recursive-sum - iterative-sum - ) - - (begin - (define (linear-recursive-sum term a next b) - (if (> a b) - 0 - (+ (term a) - (linear-recursive-sum term - (next a) - next - b)))) - - (define (iterative-sum term a next b) - (define (iter a result) - (if (> a b) - result - (iter (next a) - (+ (term a) - result))) - ) - (iter a 0)))) diff --git a/sicp/solutions/1_31.scm b/sicp/solutions/1_31.scm @@ -1,51 +0,0 @@ -(define-library (sicp solutions 1_31) - (import (scheme base)) - (export - iterative-product - recursive-product - factorial - tau-approximation - ) - - (begin - (define (identity x) x) - (define (1+ x) (+ 1 x)) - (define (1- x) (- 1 x)) - - (define (iterative-product term a next b) - (define (iter a result) - (if (> a b) - result - (iter (next a) - (* (term a) - result)))) - (iter a 1)) - - (define (factorial n) - (iterative-product identity - 1 - 1+ - n)) - - - (define (tau-approximation n) - (* 8 - (iterative-product (lambda (x) - (/ (if (odd? x) - (+ 1 x) - (+ 2 x)) - (if (odd? x) - (+ 2 x) - (+ 1 x)))) - 1 - 1+ - n))) - - (define (recursive-product term a next b) - (if (> a b) - 1 - (* (term a) - (recursive-product term - (next a) - next - b)))))) diff --git a/sicp/solutions/1_32.scm b/sicp/solutions/1_32.scm @@ -1,67 +0,0 @@ -(define-library (sicp solutions 1_32) - (import (scheme base)) - (export - iterative-accumulate - iterative-product - iterative-sum - recursive-accumulate - recursive-product - recursive-sum - ) - - (begin - (define (iterative-accumulate combiner null-value term a next b) - (define (iter a result) - (if (> a b) - result - (iter (next a) (combiner (term a) result)))) - (iter a null-value)) - - (define (recursive-accumulate combiner null-value term a next b) - (if (> a b) - null-value - (combiner (term a) - (recursive-accumulate combiner - null-value - term - (next a) - next - b)))) - - (define iterative-sum - (lambda (term a next b) - (iterative-accumulate (lambda (acc x) - (+ acc x)) - 0 - term - a - next - b))) - (define iterative-product - (lambda (term a next b) - (iterative-accumulate (lambda (acc x) - (* acc x)) - 1 - term - a - next - b))) - - (define recursive-sum - (lambda (term a next b) - (recursive-accumulate (lambda (acc x) - (+ acc x)) - 0 - term - a - next - b))) - (define recursive-product - (lambda (term a next b) - (recursive-accumulate (lambda (acc x) - (* acc x)) - 1 - term - a - next - b))))) diff --git a/sicp/solutions/1_33.scm b/sicp/solutions/1_33.scm @@ -1,54 +0,0 @@ -(define-library (sicp solutions 1_33) - (import (scheme base)) - (import (only (sicp solutions 1_21) prime?)) - (export - iterative-filtered-accumulate - iterative-sum-of-squares - recursive-filtered-accumulate - recursive-sum-of-squares - ) - - (begin - (define (iterative-filtered-accumulate predicate? combiner null-value term a next b) - (define (iter a result) - (if (> a b) - result - (if (predicate? a) - (iter (next a) - (combiner (term a) - result)) - (iter (next a) - result)))) - (iter a null-value)) - - (define (iterative-sum-of-squares a b) - (iterative-filtered-accumulate prime? - + - 0 - (lambda (x) (* x x)) - a - (lambda (x) (+ 1 x)) - b)) - - (define (recursive-filtered-accumulate predicate? combiner null-value term a next b) - (if (> a b) - null-value - (let ([recur (recursive-filtered-accumulate predicate? - combiner - null-value - term - (next a) - next - b)]) - (if (predicate? a) - (combiner (term a) recur) - recur)))) - - (define (recursive-sum-of-squares a b) - (iterative-filtered-accumulate prime? - + - 0 - (lambda (x) (* x x)) - a - (lambda (x) (+ 1 x)) - b)))) diff --git a/sicp/solutions/1_4.scm b/sicp/solutions/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/1_7.scm b/sicp/solutions/1_7.scm @@ -1,54 +0,0 @@ -(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/2_33.scm b/sicp/solutions/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/2_34.scm b/sicp/solutions/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/2_35.scm b/sicp/solutions/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/2_36.scm b/sicp/solutions/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/2_40.scm b/sicp/solutions/2_40.scm @@ -1,75 +0,0 @@ -(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/2_41.scm b/sicp/solutions/2_41.scm @@ -1,8 +0,0 @@ -(define-library (sicp solutions exercise-2.41) - (begin - (define (unique-triples n) - (flatmap (lambda (pair) - (map (lambda (k) - (append pair (list k))) - (enumerate-interval 1 (1- (cadr pair))))) - (unique-pairs n))))) diff --git a/sicp/solutions/2_42.scm b/sicp/solutions/2_42.scm @@ -1,148 +0,0 @@ -(define-library (sicp solutions exercise-2.42) - (import (scheme base)) - (import (srfi :1)) - (import (sicp utils)) - (export safe? queens make-position) - - (begin - (define (make-position row column) - (cons row column)) - - (define (position-row position) - (car position)) - - (define (position-column position) - (cdr position)) - - (define (adjoin-position row column rest-of-queens) - (cons (make-position row column) - rest-of-queens)) - - (define empty-board '()) ;; queens 0 will return [[]]. - - (define (threatening-pair? queen-a-position queen-b-position) - (define a-row (position-row queen-a-position)) - (define b-row (position-row queen-b-position)) - - (define a-column (position-column queen-a-position)) - (define b-column (position-column queen-b-position)) - - (define rows-equal (= a-row - b-row)) - - (define on-same-diagonal (= (abs (- a-row - b-row)) - (abs (- a-column - b-column)))) - - (or rows-equal - on-same-diagonal)) - - " - Q - Q - Q - -Q1 = (2, 1) -Q2 = (3, 2) -Q1 - Q2 = (2 - 3, 1 - 2) -= (-1, -1) -Q3 = (4, 3) -Q1 - Q3 = (2 - 4, 1 - 3) -= (-2, -2) - - Q - Q - Q -Q - -Q1 = (4, 1) -Q2 = (3, 2) -Q3 = (2, 3) - -Q1 - Q2 = (4 - 3, 1 - 2) -= (1, -1) -Q1 - Q3 = (4 - 2, 1 - 3) -= (2, -2) -Q1 - Q4 = (4 - 1, 1 - 4) -= (3, -3) -" - - - (define (safe? our-column board) - (define our-row (position-row (car board))) - - (if (null? - (filter - (lambda (position) - (threatening-pair? - (make-position our-row - our-column) - position)) - (cdr board))) - #t - #f)) - - (define (queens board-size) - (define (queen-cols k) - (if (= k 0) - (list empty-board) - (filter - (lambda (positions) - (safe? k - positions)) - (flatmap - (lambda (rest-of-queens) - (map (lambda (new-row) - (adjoin-position - new-row - k - rest-of-queens)) - (enumerate-interval - 1 - board-size))) - (queen-cols (- k 1)))))) - (queen-cols board-size)) - - (define (display-board board n) - (define sorted-board - (sort board - (lambda (a b) - (or - (< (position-row a) - (position-row b)) - ;; (< (position-column a) - ;; (position-column b)) - )))) - '(define sorted-board board) - - (define (display-row column n) - (pretty-print (list column n)) - (cond - ((zero? n) '()) - ((= column n) - (display "Q\n") - (display-row column (- n 1))) - (else (display ".") - (display-row column (- n 1))))) - - (for-each - (lambda (position) - (display-row - (position-column position) - n)) - sorted-board)) - - '(for-each (lambda (board) - (display-board board - (reduce - (lambda (x y) - (max (position-column x) - (position-column y))) - 0 - board)) - (pretty-print board)) - (flatmap queens - (enumerate-interval 1 8))) - - )) diff --git a/sicp/solutions/2_56.scm b/sicp/solutions/2_56.scm @@ -1,153 +0,0 @@ -(define-library (sicp solutions 2_56) - (import (scheme base)) - (import (scheme cxr)) - (export - =number? - base - deriv - exponands - exponent - exponentiation? - make-exponentiation - make-product - make-sum - multiplicand - multiplier - product? - same-variable? - sum? - variable? - augend - addend - ) - - (begin - - ;; Exercise 2.56 - - ;; Original: - ;; (define (make-sum a1 a2) - ;; (list '+ a1 a2)) - - - (define (=number? exp num) - (and (number? exp) - (= exp num))) - - ;; Simplificating make-sum: - - (define (make-sum a1 a2) - (cond - ((=number? a1 0) a2) - ((=number? a2 0) a1) - ((and (number? a1) - (number? a2)) - (+ a1 a2)) - ((and (symbol? a1) - (symbol? a2) - (eq? a1 a2)) - (list '+ 2 a1)) - (else (list '+ a1 a2)))) - - (define (sum? x) - (and (pair? x) - (eq? (car x) - '+))) - - (define (addend s) - (cadr s)) - - (define (augend s) - (caddr s)) - - ;; Original: - ;; (define (make-product m1 m2) - ;; (list '* m1 m2)) - - ;; Simplificating make-product: - - (define (make-product m1 m2) - (cond - ((or (=number? m1 0) - (=number? m2 0)) - 0) - ((=number? m1 1) m2) - ((=number? m2 1) m1) - ((and (number? m1) - (number? m2)) - (* m1 m2)) - ((and (symbol? m1) - (symbol? m2) - (eq? m1 m2)) - (make-exponentiation m1 2)) - (else (list '* m1 m2)))) - - (define (product? x) - (and (pair? x) - (eq? (car x) - '*))) - - (define (multiplier p) - (cadr p)) - - (define (multiplicand p) - (caddr p)) - - (define (make-exponentiation b e) - (cond - ((=number? e 0) 1) - ((=number? e 1) b) - ((=number? b 1) 1) - (else (list '** b e)))) - - ;; Exercise 2.56 - - (define (exponentiation? e) - (and (pair? e) - (eq? (car e) - '**))) - - (define (base e) - (cadr e)) - - (define (exponent e) - (caddr e)) - - (define (variable? x) - (symbol? x)) - - (define (same-variable? v1 v2) - (and (variable? v1) - (variable? v2) - (eq? v1 v2))) - - (define (deriv exp var) - (cond - ((number? exp) 0) - ((variable? exp) - (if (same-variable? exp - var) - 1 - 0)) - ((sum? exp) - (make-sum (deriv (addend exp) - var) - (deriv (augend exp) - var))) - ((product? exp) - (make-sum - (make-product (multiplier exp) - (deriv (multiplicand exp) - var)) - (make-product (deriv (multiplier exp) - var) - (multiplicand exp)))) - ;; Exercise 2.56 - ((exponentiation? exp) - ;; d(x**n)/dx = n*x**(n-1) - (make-product (exponent exp) - (make-exponentiation (base exp) - (make-sum (exponent exp) - -1)))) - (else (error "Unknown expression - type: DERIV" exp)))))) diff --git a/sicp/solutions/2_7.scm b/sicp/solutions/2_7.scm @@ -1,45 +0,0 @@ -(define-library (sicp solutions 2_7) - (import (scheme base)) - (export - lower-bound - make-interval - upper-bound - ) - - (begin - (define (make-interval lower higher) - (cons lower higher)) - (define (lower-bound interval) - (car interval)) - (define (upper-bound interval) - (cdr interval)) - - (define (add-interval x y) - (make-interval (+ (lower-bound x) - (lower-bound y)) - (+ (upper-bound x) - (upper-bound y)))) - - (define (mul-interval x y) - (let* ((bound-getters (list lower-bound higher-bound)) - (ps (list-ec (: x-bound bound-getters) - (: y-bound bound-getters) - (* (x-bound x) - (y-bound y))))) - (make-interval (min ps) - (max ps)))) - - (define (div-interval x y) - (mul-interval x (make-interval (/ 1.0 (upper-bound y)) - (/ 1.0 (lower-bound y))))) - - (define (sub-interval x y) - (make-interval (- (lower-bound x) - (lower-bound y)) - (- (upper-bound x) - (upper-bound y)))) - - (define (width-interval x) - (/ (- (upper-bound x) - (lower-bound x)) - 2)))) diff --git a/sicp/solutions/2_73.scm b/sicp/solutions/2_73.scm @@ -1,110 +0,0 @@ -(define-library (sicp solutions 2_73) - (import (scheme base)) - (import (scheme cxr)) - (import (scheme write)) - (import (srfi :26)) - (import (srfi :111)) - (import (sicp utils)) - (import (only (sicp solutions 2_56) - =number? - make-exponentiation - make-product - make-sum - same-variable? - )) - (export deriv - get - put) - - (begin - (define put-get-table '()) - - (define (put operator data-type proc) - (define new-key (cons operator data-type)) - (define new-key-value-pair (cons new-key proc)) - (set! put-get-table - (cons new-key-value-pair - (filter - (lambda (key-value-pair) - (not - (equal? - (car key-value-pair) - new-key))) - put-get-table)))) - - (define (get op data-type) - (define search-result - (filter (lambda (key-value-pair) - (equal? - (cons op data-type) - (car key-value-pair))) - put-get-table)) - (if (null? search-result) - (error "Unknown expression type: " op data-type) - (cdar search-result))) - - (define (operator exp) - (car exp)) - - (define (operands exp) - (cdr exp)) - - (define (variable? exp) - (symbol? exp)) - - (define (deriv exp var) - (cond - ((number? exp) 0) - ((variable? exp) - (if (same-variable? exp var) - 1 - 0)) - (else - ((get 'deriv (operator exp)) - (operands exp) - var)))) - - (define (addend exp) - (car exp)) - - (define (augend exp) - (cadr exp)) - - (put 'deriv - '+ - (lambda (exp var) - (display (list 'deriv '+ exp var)) - (newline) - (make-sum - (deriv (addend exp) var) - (deriv (augend exp) var)))) - - (define (multiplier p) - (car p)) - - (define (multiplicand p) - (cadr p)) - - (put 'deriv - '* - (lambda (exp var) - (make-sum - (make-product (multiplier exp) - (deriv (multiplicand exp) var)) - (make-product (deriv (multiplier exp) var) - (multiplicand exp))))) - - (define (base e) - (car e)) - - (define (exponent e) - (cadr e)) - - (put 'deriv - '** - (lambda (exp var) - (display (list 'deriv '** exp var)) - (newline) - (make-product (exponent exp) - (make-exponentiation (base exp) - (make-sum (exponent exp) -1))))))) diff --git a/sicp/solutions/2_75.scm b/sicp/solutions/2_75.scm @@ -1,24 +0,0 @@ -(define-library (sicp solutions 2_75) - (import (scheme base)) - (import (only (rnrs) cos sin)) - (import (sicp utils)) - (export - make-from-mag-ang - ) - - (begin - (define (make-from-mag-ang mag ang) - (define (dispatch op) - (cond - ((eq? op 'real-part) - (* mag - (cos ang))) - ((eq? op 'imag-part) - (* mag - (sin ang))) - ((eq? op 'magnitude) mag) - ((eq? op 'angle) ang) - (else - (error "Unknown op: make-from-mag-ang" op)))) - - dispatch))) diff --git a/sicp/solutions/3_12.scm b/sicp/solutions/3_12.scm @@ -1,16 +0,0 @@ -(define-library (sicp solutions 3_12) - (import (scheme base)) - (export - append! - last-pair - ) - - (begin - (define (last-pair x) - (cond - ((null? (cdr x)) x) - (else (last-pair (cdr x))))) - - (define (append! x y) - (set-cdr! (last-pair x) y) - x))) diff --git a/sicp/solutions/3_13.scm b/sicp/solutions/3_13.scm @@ -1,13 +0,0 @@ -(define-library (sicp solutions 3_13) - (import (scheme base)) - (export make-cycle) - - (begin - (define (last-pair x) - (if (null? (cdr x)) - x - (last-pair (cdr x)))) - - (define (make-cycle x) - (set-cdr! (last-pair x) x) - x))) diff --git a/sicp/solutions/chapter-1/exercise-1.scm b/sicp/solutions/chapter-1/exercise-1.scm @@ -0,0 +1,29 @@ +(define-library (sicp solutions chapter-1 exercise-1) + (import (scheme base)) + (export + a + b + 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/1_10.scm b/sicp/solutions/chapter-1/exercise-10.scm diff --git a/sicp/solutions/1_11.scm b/sicp/solutions/chapter-1/exercise-11.scm diff --git a/sicp/solutions/1_12.scm b/sicp/solutions/chapter-1/exercise-12.scm diff --git a/sicp/solutions/1_13.scm b/sicp/solutions/chapter-1/exercise-13.scm diff --git a/sicp/solutions/1_14.scm b/sicp/solutions/chapter-1/exercise-14.scm diff --git a/sicp/solutions/1_16.scm b/sicp/solutions/chapter-1/exercise-16.scm diff --git a/sicp/solutions/1_17.scm b/sicp/solutions/chapter-1/exercise-17.scm diff --git a/sicp/solutions/1_18.scm b/sicp/solutions/chapter-1/exercise-18.scm diff --git a/sicp/solutions/1_19.scm b/sicp/solutions/chapter-1/exercise-19.scm diff --git a/sicp/solutions/chapter-1/exercise-2.scm b/sicp/solutions/chapter-1/exercise-2.scm @@ -0,0 +1,30 @@ +(define-library (sicp solutions chapter-1 exercise-2) + (import (scheme base)) + (import (srfi srfi-64)) + + (begin + + #! + + *Exercise 1.2:* Translate the following expression into prefix + form. + + 5 + 4 + (2 - (3 - (6 + 4/5))) + ----------------------------- + 3(6 - 2)(2 - 7) + + !# + + (test-begin "1.2") + (test-equal + (/ (+ 5 + 4 + (- 2 + (- 3 + (+ 6 + (/ 4 5))))) + (* 3 + (- 6 2) + (- 2 7))) + (/ (- 37) 150)) + (test-end "1.2"))) diff --git a/sicp/solutions/1_20.scm b/sicp/solutions/chapter-1/exercise-20.scm diff --git a/sicp/solutions/chapter-1/exercise-21.scm b/sicp/solutions/chapter-1/exercise-21.scm @@ -0,0 +1,64 @@ +(define-library (sicp solutions chapter-1 exercise-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/1_22.scm b/sicp/solutions/chapter-1/exercise-22.scm diff --git a/sicp/solutions/1_23.scm b/sicp/solutions/chapter-1/exercise-23.scm diff --git a/sicp/solutions/1_24.scm b/sicp/solutions/chapter-1/exercise-24.scm diff --git a/sicp/solutions/chapter-1/exercise-3.scm b/sicp/solutions/chapter-1/exercise-3.scm @@ -0,0 +1,25 @@ +(define-library (sicp solutions chapter-1 exercise-3) + (import + (scheme base) + (srfi srfi-64) + (only (sicp solutions chapter-1 exercise-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/chapter-1/exercise-30.scm b/sicp/solutions/chapter-1/exercise-30.scm @@ -0,0 +1,26 @@ +(define-library (sicp solutions chapter-1 exercise-30) + (import (scheme base)) + (export + linear-recursive-sum + iterative-sum + ) + + (begin + (define (linear-recursive-sum term a next b) + (if (> a b) + 0 + (+ (term a) + (linear-recursive-sum term + (next a) + next + b)))) + + (define (iterative-sum term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) + (+ (term a) + result))) + ) + (iter a 0)))) diff --git a/sicp/solutions/chapter-1/exercise-31.scm b/sicp/solutions/chapter-1/exercise-31.scm @@ -0,0 +1,51 @@ +(define-library (sicp solutions chapter-1 exercise-31) + (import (scheme base)) + (export + iterative-product + recursive-product + factorial + tau-approximation + ) + + (begin + (define (identity x) x) + (define (1+ x) (+ 1 x)) + (define (1- x) (- 1 x)) + + (define (iterative-product term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) + (* (term a) + result)))) + (iter a 1)) + + (define (factorial n) + (iterative-product identity + 1 + 1+ + n)) + + + (define (tau-approximation n) + (* 8 + (iterative-product (lambda (x) + (/ (if (odd? x) + (+ 1 x) + (+ 2 x)) + (if (odd? x) + (+ 2 x) + (+ 1 x)))) + 1 + 1+ + n))) + + (define (recursive-product term a next b) + (if (> a b) + 1 + (* (term a) + (recursive-product term + (next a) + next + b)))))) diff --git a/sicp/solutions/chapter-1/exercise-32.scm b/sicp/solutions/chapter-1/exercise-32.scm @@ -0,0 +1,67 @@ +(define-library (sicp solutions chapter-1 exercise-32) + (import (scheme base)) + (export + iterative-accumulate + iterative-product + iterative-sum + recursive-accumulate + recursive-product + recursive-sum + ) + + (begin + (define (iterative-accumulate combiner null-value term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) (combiner (term a) result)))) + (iter a null-value)) + + (define (recursive-accumulate combiner null-value term a next b) + (if (> a b) + null-value + (combiner (term a) + (recursive-accumulate combiner + null-value + term + (next a) + next + b)))) + + (define iterative-sum + (lambda (term a next b) + (iterative-accumulate (lambda (acc x) + (+ acc x)) + 0 + term + a + next + b))) + (define iterative-product + (lambda (term a next b) + (iterative-accumulate (lambda (acc x) + (* acc x)) + 1 + term + a + next + b))) + + (define recursive-sum + (lambda (term a next b) + (recursive-accumulate (lambda (acc x) + (+ acc x)) + 0 + term + a + next + b))) + (define recursive-product + (lambda (term a next b) + (recursive-accumulate (lambda (acc x) + (* acc x)) + 1 + term + a + next + b))))) diff --git a/sicp/solutions/chapter-1/exercise-33.scm b/sicp/solutions/chapter-1/exercise-33.scm @@ -0,0 +1,54 @@ +(define-library (sicp solutions chapter-1 exercise-33) + (import (scheme base)) + (import (only (sicp solutions chapter-1 exercise-21) prime?)) + (export + iterative-filtered-accumulate + iterative-sum-of-squares + recursive-filtered-accumulate + recursive-sum-of-squares + ) + + (begin + (define (iterative-filtered-accumulate predicate? combiner null-value term a next b) + (define (iter a result) + (if (> a b) + result + (if (predicate? a) + (iter (next a) + (combiner (term a) + result)) + (iter (next a) + result)))) + (iter a null-value)) + + (define (iterative-sum-of-squares a b) + (iterative-filtered-accumulate prime? + + + 0 + (lambda (x) (* x x)) + a + (lambda (x) (+ 1 x)) + b)) + + (define (recursive-filtered-accumulate predicate? combiner null-value term a next b) + (if (> a b) + null-value + (let ([recur (recursive-filtered-accumulate predicate? + combiner + null-value + term + (next a) + next + b)]) + (if (predicate? a) + (combiner (term a) recur) + recur)))) + + (define (recursive-sum-of-squares a b) + (iterative-filtered-accumulate prime? + + + 0 + (lambda (x) (* x x)) + a + (lambda (x) (+ 1 x)) + b)))) diff --git a/sicp/solutions/1_34.scm b/sicp/solutions/chapter-1/exercise-34.scm diff --git a/sicp/solutions/chapter-1/exercise-4.scm b/sicp/solutions/chapter-1/exercise-4.scm @@ -0,0 +1,27 @@ +(define-library (sicp solutions chapter-1 exercise-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/1_42.scm b/sicp/solutions/chapter-1/exercise-42.scm diff --git a/sicp/solutions/1_5.scm b/sicp/solutions/chapter-1/exercise-5.scm diff --git a/sicp/solutions/1_6.scm b/sicp/solutions/chapter-1/exercise-6.scm diff --git a/sicp/solutions/chapter-1/exercise-7.scm b/sicp/solutions/chapter-1/exercise-7.scm @@ -0,0 +1,54 @@ +(define-library (sicp solutions chapter-1 exercise-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/1_8.scm b/sicp/solutions/chapter-1/exercise-8.scm diff --git a/sicp/solutions/1_9.scm b/sicp/solutions/chapter-1/exercise-9.scm diff --git a/sicp/solutions/2_1.scm b/sicp/solutions/chapter-2/exercise-1.scm diff --git a/sicp/solutions/2_17.scm b/sicp/solutions/chapter-2/exercise-17.scm diff --git a/sicp/solutions/2_18.scm b/sicp/solutions/chapter-2/exercise-18.scm diff --git a/sicp/solutions/2_19.scm b/sicp/solutions/chapter-2/exercise-19.scm diff --git a/sicp/solutions/2_2.scm b/sicp/solutions/chapter-2/exercise-2.scm diff --git a/sicp/solutions/2_20.scm b/sicp/solutions/chapter-2/exercise-20.scm diff --git a/sicp/solutions/2_21.scm b/sicp/solutions/chapter-2/exercise-21.scm diff --git a/sicp/solutions/2_22.scm b/sicp/solutions/chapter-2/exercise-22.scm diff --git a/sicp/solutions/2_23.scm b/sicp/solutions/chapter-2/exercise-23.scm diff --git a/sicp/solutions/2_24.scm b/sicp/solutions/chapter-2/exercise-24.scm diff --git a/sicp/solutions/2_25.scm b/sicp/solutions/chapter-2/exercise-25.scm diff --git a/sicp/solutions/2_26.scm b/sicp/solutions/chapter-2/exercise-26.scm diff --git a/sicp/solutions/2_27.scm b/sicp/solutions/chapter-2/exercise-27.scm diff --git a/sicp/solutions/2_28.scm b/sicp/solutions/chapter-2/exercise-28.scm diff --git a/sicp/solutions/2_29.scm b/sicp/solutions/chapter-2/exercise-29.scm diff --git a/sicp/solutions/chapter-2/exercise-2_4-complex-numbers.scm b/sicp/solutions/chapter-2/exercise-2_4-complex-numbers.scm @@ -0,0 +1,80 @@ +(define-library (2_4-complex-numbers) + (import (scheme base)) + + (begin + (define (type-tag datum) + (if (and (pair? datum) + (symbol? (car datum))) + (car datum) + (error "Bad tagged datum: TYPE-TAG " datum))) + + (define (contents datum) + (if (and (pair? datum) + (symbol? (car datum))) + (cdr datum) + (error "Bad tagged datum: CONTENTS " datum))) + + (define (rectangular? z) + (eq? (type-tag z) 'rectangular)) + + (define (polar? z) + (eq? (type-tag z) 'polar)) + + ;; Ben representation + + (define (real-part-rectangular z) (car z)) + (define (imag-part-rectangular z) (cdr z)) + + (define (magnitude-rectangular z) + (sqrt (+ (square (real-part-rectangular z)) + (square (imag-part-rectangular z))))) + + (define (angle-rectangular z) + (atan (imag-part-rectangular z) + (real-part-rectangular z))) + + (define (make-from-real-imag-rectangular x y) + (attach-tag 'rectangular (cons x y))) + + (define (make-from-mag-ang-rectangular r a) + (attach-tag + 'rectangular + (cons (* r (cos a)) + (* r (sin a))))) + + ;; Alyssa representation + + (define (real-part-polar z) + (* (magnitude-poler z) + (cos (angle-polar z)))) + + (define (imag-part-polar z) + (* (magnitude-poler z) + (sin (angle-polar z)))) + + (define (magnitude-part-polar z) + (car z)) + + (define (angle-part-polar z) + (cdr z)) + + (define (make-from-real-imag real imag) + (list 'complex-real-imag real imag)) + + (define (make-from-mag-ang mag ang) + (list 'comlex-mag-ang mag ang)) + + (define (add-complex z1 z2) + (make-from-real-imag + (+ (real-part z1) (real-part z2)) + (+ (imag-part z1) (imag-part z2)))) + + (define (mul-complex z1 z2) + (make-from-real-imag + (* (magnitude z1) (magnitude z2)) + (+ (angle z1) (angle z2)))) + + (define (sub-complex z1 z2) + (make-from-real-imag + (/ (magnitude z1) (magnitude z2)) + (- (angle z1) (angle z2)))))) diff --git a/sicp/solutions/2_3.scm b/sicp/solutions/chapter-2/exercise-3.scm diff --git a/sicp/solutions/2_30.scm b/sicp/solutions/chapter-2/exercise-30.scm diff --git a/sicp/solutions/2_31.scm b/sicp/solutions/chapter-2/exercise-31.scm diff --git a/sicp/solutions/2_32.scm b/sicp/solutions/chapter-2/exercise-32.scm diff --git a/sicp/solutions/chapter-2/exercise-33.scm b/sicp/solutions/chapter-2/exercise-33.scm @@ -0,0 +1,40 @@ +(define-library (sicp solutions chapter-2 exercise-33) + (import (scheme base)) + (import (sicp 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/chapter-2/exercise-34.scm b/sicp/solutions/chapter-2/exercise-34.scm @@ -0,0 +1,14 @@ +(define-library (sicp solutions chapter-2 exercise-34) + (import (scheme base)) + (import (sicp 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/chapter-2/exercise-35.scm b/sicp/solutions/chapter-2/exercise-35.scm @@ -0,0 +1,22 @@ +(define-library (sicp solutions chapter-2 exercise-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/chapter-2/exercise-36.scm b/sicp/solutions/chapter-2/exercise-36.scm @@ -0,0 +1,18 @@ +(define-library (sicp solutions chapter-2 exercise-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/2_37.scm b/sicp/solutions/chapter-2/exercise-37.scm diff --git a/sicp/solutions/2_38.scm b/sicp/solutions/chapter-2/exercise-38.scm diff --git a/sicp/solutions/2_39.scm b/sicp/solutions/chapter-2/exercise-39.scm diff --git a/sicp/solutions/2_4.scm b/sicp/solutions/chapter-2/exercise-4.scm diff --git a/sicp/solutions/chapter-2/exercise-40.scm b/sicp/solutions/chapter-2/exercise-40.scm @@ -0,0 +1,75 @@ +(define-library (sicp solutions chapter-2 exercise-40) + (import (scheme base) + (only (sicp utils) + accumulate + enumerate-interval + filter + flatmap) + (only (sicp solutions chapter-1 exercise-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/chapter-2/exercise-41.scm b/sicp/solutions/chapter-2/exercise-41.scm @@ -0,0 +1,13 @@ +(define-library (sicp solutions chapter-2 exercise-41) + (import (scheme base) + (only (sicp solutions chapter-2 exercise-40) unique-pairs) + (only (sicp utils) flatmap)) + + (begin + (define (unique-triples n) + (flatmap (lambda (pair) + (map (lambda (k) + (append pair (list k))) + (enumerate-interval 1 (- (cadr pair) + 1)))) + (unique-pairs n))))) diff --git a/sicp/solutions/chapter-2/exercise-42.scm b/sicp/solutions/chapter-2/exercise-42.scm @@ -0,0 +1,146 @@ +(define-library (sicp solutions chapter-2 exercise-42) + (import (scheme base) + (srfi :1) + (sicp utils)) + (export safe? queens make-position) + + (begin + (define (make-position row column) + (cons row column)) + + (define (position-row position) + (car position)) + + (define (position-column position) + (cdr position)) + + (define (adjoin-position row column rest-of-queens) + (cons (make-position row column) + rest-of-queens)) + + (define empty-board '()) ;; queens 0 will return [[]]. + + (define (threatening-pair? queen-a-position queen-b-position) + (define a-row (position-row queen-a-position)) + (define b-row (position-row queen-b-position)) + + (define a-column (position-column queen-a-position)) + (define b-column (position-column queen-b-position)) + + (define rows-equal (= a-row + b-row)) + + (define on-same-diagonal (= (abs (- a-row + b-row)) + (abs (- a-column + b-column)))) + + (or rows-equal + on-same-diagonal)) + + " + Q + Q + Q + +Q1 = (2, 1) +Q2 = (3, 2) +Q1 - Q2 = (2 - 3, 1 - 2) += (-1, -1) +Q3 = (4, 3) +Q1 - Q3 = (2 - 4, 1 - 3) += (-2, -2) + + Q + Q + Q +Q + +Q1 = (4, 1) +Q2 = (3, 2) +Q3 = (2, 3) + +Q1 - Q2 = (4 - 3, 1 - 2) += (1, -1) +Q1 - Q3 = (4 - 2, 1 - 3) += (2, -2) +Q1 - Q4 = (4 - 1, 1 - 4) += (3, -3) +" + + + (define (safe? our-column board) + (define our-row (position-row (car board))) + + (if (null? + (filter + (lambda (position) + (threatening-pair? + (make-position our-row + our-column) + position)) + (cdr board))) + #t + #f)) + + (define (queens board-size) + (define (queen-cols k) + (if (= k 0) + (list empty-board) + (filter + (lambda (positions) + (safe? k + positions)) + (flatmap + (lambda (rest-of-queens) + (map (lambda (new-row) + (adjoin-position + new-row + k + rest-of-queens)) + (enumerate-interval + 1 + board-size))) + (queen-cols (- k 1)))))) + (queen-cols board-size)) + + (define (display-board board n) + (define sorted-board + (sort board + (lambda (a b) + (or + (< (position-row a) + (position-row b)) + ;; (< (position-column a) + ;; (position-column b)) + )))) + '(define sorted-board board) + + (define (display-row column n) + (pretty-print (list column n)) + (cond + ((zero? n) '()) + ((= column n) + (display "Q\n") + (display-row column (- n 1))) + (else (display ".") + (display-row column (- n 1))))) + + (for-each + (lambda (position) + (display-row + (position-column position) + n)) + sorted-board)) + + '(for-each (lambda (board) + (display-board board + (reduce + (lambda (x y) + (max (position-column x) + (position-column y))) + 0 + board)) + (pretty-print board)) + (flatmap queens + (enumerate-interval 1 8))))) diff --git a/sicp/solutions/2_5.scm b/sicp/solutions/chapter-2/exercise-5.scm diff --git a/sicp/solutions/2_53.scm b/sicp/solutions/chapter-2/exercise-53.scm diff --git a/sicp/solutions/2_54.scm b/sicp/solutions/chapter-2/exercise-54.scm diff --git a/sicp/solutions/2_55.scm b/sicp/solutions/chapter-2/exercise-55.scm diff --git a/sicp/solutions/chapter-2/exercise-56.scm b/sicp/solutions/chapter-2/exercise-56.scm @@ -0,0 +1,153 @@ +(define-library (sicp solutions chapter-2 exercise-56) + (import (scheme base) + (scheme cxr)) + (export + =number? + base + deriv + exponands + exponent + exponentiation? + make-exponentiation + make-product + make-sum + multiplicand + multiplier + product? + same-variable? + sum? + variable? + augend + addend + ) + + (begin + + ;; Exercise 2.56 + + ;; Original: + ;; (define (make-sum a1 a2) + ;; (list '+ a1 a2)) + + + (define (=number? exp num) + (and (number? exp) + (= exp num))) + + ;; Simplificating make-sum: + + (define (make-sum a1 a2) + (cond + ((=number? a1 0) a2) + ((=number? a2 0) a1) + ((and (number? a1) + (number? a2)) + (+ a1 a2)) + ((and (symbol? a1) + (symbol? a2) + (eq? a1 a2)) + (list '+ 2 a1)) + (else (list '+ a1 a2)))) + + (define (sum? x) + (and (pair? x) + (eq? (car x) + '+))) + + (define (addend s) + (cadr s)) + + (define (augend s) + (caddr s)) + + ;; Original: + ;; (define (make-product m1 m2) + ;; (list '* m1 m2)) + + ;; Simplificating make-product: + + (define (make-product m1 m2) + (cond + ((or (=number? m1 0) + (=number? m2 0)) + 0) + ((=number? m1 1) m2) + ((=number? m2 1) m1) + ((and (number? m1) + (number? m2)) + (* m1 m2)) + ((and (symbol? m1) + (symbol? m2) + (eq? m1 m2)) + (make-exponentiation m1 2)) + (else (list '* m1 m2)))) + + (define (product? x) + (and (pair? x) + (eq? (car x) + '*))) + + (define (multiplier p) + (cadr p)) + + (define (multiplicand p) + (caddr p)) + + (define (make-exponentiation b e) + (cond + ((=number? e 0) 1) + ((=number? e 1) b) + ((=number? b 1) 1) + (else (list '** b e)))) + + ;; Exercise 2.56 + + (define (exponentiation? e) + (and (pair? e) + (eq? (car e) + '**))) + + (define (base e) + (cadr e)) + + (define (exponent e) + (caddr e)) + + (define (variable? x) + (symbol? x)) + + (define (same-variable? v1 v2) + (and (variable? v1) + (variable? v2) + (eq? v1 v2))) + + (define (deriv exp var) + (cond + ((number? exp) 0) + ((variable? exp) + (if (same-variable? exp + var) + 1 + 0)) + ((sum? exp) + (make-sum (deriv (addend exp) + var) + (deriv (augend exp) + var))) + ((product? exp) + (make-sum + (make-product (multiplier exp) + (deriv (multiplicand exp) + var)) + (make-product (deriv (multiplier exp) + var) + (multiplicand exp)))) + ;; Exercise 2.56 + ((exponentiation? exp) + ;; d(x**n)/dx = n*x**(n-1) + (make-product (exponent exp) + (make-exponentiation (base exp) + (make-sum (exponent exp) + -1)))) + (else (error "Unknown expression + type: DERIV" exp)))))) diff --git a/sicp/solutions/2_59.scm b/sicp/solutions/chapter-2/exercise-59.scm diff --git a/sicp/solutions/2_6.scm b/sicp/solutions/chapter-2/exercise-6.scm diff --git a/sicp/solutions/2_60.scm b/sicp/solutions/chapter-2/exercise-60.scm diff --git a/sicp/solutions/2_61-2_62.scm b/sicp/solutions/chapter-2/exercise-61-62.scm diff --git a/sicp/solutions/2_64.scm b/sicp/solutions/chapter-2/exercise-64.scm diff --git a/sicp/solutions/chapter-2/exercise-7.scm b/sicp/solutions/chapter-2/exercise-7.scm @@ -0,0 +1,48 @@ +(define-library (sicp solutions chapter-2 exercise-7) + (import (scheme base) + (srfi :42)) + (export + add-interval + lower-bound + make-interval + upper-bound + width-interval + ) + + (begin + (define (make-interval lower higher) + (cons lower higher)) + (define (lower-bound interval) + (car interval)) + (define (upper-bound interval) + (cdr interval)) + + (define (add-interval x y) + (make-interval (+ (lower-bound x) + (lower-bound y)) + (+ (upper-bound x) + (upper-bound y)))) + + (define (mul-interval x y) + (let* ((bound-getters (list lower-bound higher-bound)) + (ps (list-ec (: x-bound bound-getters) + (: y-bound bound-getters) + (* (x-bound x) + (y-bound y))))) + (make-interval (min ps) + (max ps)))) + + (define (div-interval x y) + (mul-interval x (make-interval (/ 1.0 (upper-bound y)) + (/ 1.0 (lower-bound y))))) + + (define (sub-interval x y) + (make-interval (- (lower-bound x) + (lower-bound y)) + (- (upper-bound x) + (upper-bound y)))) + + (define (width-interval x) + (/ (- (upper-bound x) + (lower-bound x)) + 2)))) diff --git a/sicp/solutions/chapter-2/exercise-73.scm b/sicp/solutions/chapter-2/exercise-73.scm @@ -0,0 +1,110 @@ +(define-library (sicp solutions chapter-2 exercise-73) + (import (scheme base)) + (import (scheme cxr)) + (import (scheme write)) + (import (srfi :26)) + (import (srfi :111)) + (import (sicp utils)) + (import (only (sicp solutions chapter-2 exercise-56) + =number? + make-exponentiation + make-product + make-sum + same-variable? + )) + (export deriv + get + put) + + (begin + (define put-get-table '()) + + (define (put operator data-type proc) + (define new-key (cons operator data-type)) + (define new-key-value-pair (cons new-key proc)) + (set! put-get-table + (cons new-key-value-pair + (filter + (lambda (key-value-pair) + (not + (equal? + (car key-value-pair) + new-key))) + put-get-table)))) + + (define (get op data-type) + (define search-result + (filter (lambda (key-value-pair) + (equal? + (cons op data-type) + (car key-value-pair))) + put-get-table)) + (if (null? search-result) + (error "Unknown expression type: " op data-type) + (cdar search-result))) + + (define (operator exp) + (car exp)) + + (define (operands exp) + (cdr exp)) + + (define (variable? exp) + (symbol? exp)) + + (define (deriv exp var) + (cond + ((number? exp) 0) + ((variable? exp) + (if (same-variable? exp var) + 1 + 0)) + (else + ((get 'deriv (operator exp)) + (operands exp) + var)))) + + (define (addend exp) + (car exp)) + + (define (augend exp) + (cadr exp)) + + (put 'deriv + '+ + (lambda (exp var) + (display (list 'deriv '+ exp var)) + (newline) + (make-sum + (deriv (addend exp) var) + (deriv (augend exp) var)))) + + (define (multiplier p) + (car p)) + + (define (multiplicand p) + (cadr p)) + + (put 'deriv + '* + (lambda (exp var) + (make-sum + (make-product (multiplier exp) + (deriv (multiplicand exp) var)) + (make-product (deriv (multiplier exp) var) + (multiplicand exp))))) + + (define (base e) + (car e)) + + (define (exponent e) + (cadr e)) + + (put 'deriv + '** + (lambda (exp var) + (display (list 'deriv '** exp var)) + (newline) + (make-product (exponent exp) + (make-exponentiation (base exp) + (make-sum (exponent exp) -1))))))) diff --git a/sicp/solutions/chapter-2/exercise-75.scm b/sicp/solutions/chapter-2/exercise-75.scm @@ -0,0 +1,24 @@ +(define-library (sicp solutions chapter-2 exercise-75) + (import (scheme base) + (only (rnrs) cos sin) + (sicp utils)) + (export + make-from-mag-ang + ) + + (begin + (define (make-from-mag-ang mag ang) + (define (dispatch op) + (cond + ((eq? op 'real-part) + (* mag + (cos ang))) + ((eq? op 'imag-part) + (* mag + (sin ang))) + ((eq? op 'magnitude) mag) + ((eq? op 'angle) ang) + (else + (error "Unknown op: make-from-mag-ang" op)))) + + dispatch))) diff --git a/sicp/solutions/3_1.scm b/sicp/solutions/chapter-3/exercise-1.scm diff --git a/sicp/solutions/chapter-3/exercise-12.scm b/sicp/solutions/chapter-3/exercise-12.scm @@ -0,0 +1,16 @@ +(define-library (sicp solutions chapter-3 exercise-12) + (import (scheme base)) + (export + append! + last-pair + ) + + (begin + (define (last-pair x) + (cond + ((null? (cdr x)) x) + (else (last-pair (cdr x))))) + + (define (append! x y) + (set-cdr! (last-pair x) y) + x))) diff --git a/sicp/solutions/chapter-3/exercise-13.scm b/sicp/solutions/chapter-3/exercise-13.scm @@ -0,0 +1,13 @@ +(define-library (sicp solutions chapter-3 exercise-13) + (import (scheme base)) + (export make-cycle) + + (begin + (define (last-pair x) + (if (null? (cdr x)) + x + (last-pair (cdr x)))) + + (define (make-cycle x) + (set-cdr! (last-pair x) x) + x))) diff --git a/sicp/solutions/3_14.scm b/sicp/solutions/chapter-3/exercise-14.scm diff --git a/sicp/solutions/3_17.scm b/sicp/solutions/chapter-3/exercise-17.scm diff --git a/sicp/solutions/3_18.scm b/sicp/solutions/chapter-3/exercise-18.scm diff --git a/sicp/solutions/3_19.scm b/sicp/solutions/chapter-3/exercise-19.scm diff --git a/sicp/solutions/3_2.scm b/sicp/solutions/chapter-3/exercise-2.scm diff --git a/sicp/solutions/3_21.scm b/sicp/solutions/chapter-3/exercise-21.scm diff --git a/sicp/solutions/3_22.scm b/sicp/solutions/chapter-3/exercise-22.scm diff --git a/sicp/solutions/3_23/3_23.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/3_23.scm diff --git a/sicp/solutions/3_23/deque-to-list.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/deque-to-list.scm diff --git a/sicp/solutions/3_23/doubly-linked-list.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/doubly-linked-list.scm diff --git a/sicp/solutions/3_23/empty-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/empty-deque.scm diff --git a/sicp/solutions/3_23/front-delete-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/front-delete-deque.scm diff --git a/sicp/solutions/3_23/front-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/front-deque.scm diff --git a/sicp/solutions/3_23/front-insert-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/front-insert-deque.scm diff --git a/sicp/solutions/3_23/front-ptr.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/front-ptr.scm diff --git a/sicp/solutions/3_23/make-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/make-deque.scm diff --git a/sicp/solutions/3_23/one-item-in-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/one-item-in-deque.scm diff --git a/sicp/solutions/3_23/print-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/print-deque.scm diff --git a/sicp/solutions/3_23/rear-delete-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/rear-delete-deque.scm diff --git a/sicp/solutions/3_23/rear-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/rear-deque.scm diff --git a/sicp/solutions/3_23/rear-insert-deque.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/rear-insert-deque.scm diff --git a/sicp/solutions/3_23/rear-ptr.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/rear-ptr.scm diff --git a/sicp/solutions/3_23/set-front-ptr.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/set-front-ptr.scm diff --git a/sicp/solutions/3_23/set-rear-ptr.scm b/sicp/solutions/chapter-3/exercise-23-stuff.scm/set-rear-ptr.scm diff --git a/sicp/solutions/chapter-3/exercise-24.scm b/sicp/solutions/chapter-3/exercise-24.scm @@ -0,0 +1,42 @@ +(define-library (sicp solutions 3.24) + (import (scheme base)) + + (begin + (define (my-assoc same-key? key table) + (if (null? table) + #f + (let ((record (car table))) + (if (same-key? key (car record)) + record + #f)))) + + (define (make-table same-key?) + (let ((local-table (list '*table*))) + (define (lookup key) + (let ((record (my-assoc same-key? + key + local-table))) + (if record + record + #f))) + + (define (insert! key value) + (let ((record (my-assoc same-key? + key + table))) + (if record + (set-cdr! record + value) + (set-cdr! local-table + (cons (cons key value) + (cdr local-table))))) + + 'ok) + + (define (dispatch m) + (cond + ((eq? m 'lookup) lookup) + ((eq? m 'insert!) insert!) + (else (error "Unknown operation TABLE: " m)))) + + dispatch)))) diff --git a/sicp/solutions/chapter-3/exercise-25.scm b/sicp/solutions/chapter-3/exercise-25.scm @@ -0,0 +1,107 @@ +(define-library (sicp solutions 3_25) + (import (scheme base)) + (import (scheme write)) + + (export + make-table + ) + + (begin + (define (make-table) + "Returns a dispatch procedure which accepts a symbol and returns the +procedure associated with that symbol, if there is no procedure +associated with that symbol, raise an error." + (let ((local-table (list '*table*))) + ;; A table is a cons whose car is the symbol '*table* and its + ;; cdr is an inner-table. An inner-table is a list whose + ;; members are conses whose cars are symbols, the keys of the + ;; values, and its cdrs are either inner-table or the value of + ;; the sequence of symbols (keys) leading to the value. + (define (lookup keys) + "Accept KEYS, a list of symbols. + +Returns the value associated with KEYS. + +If KEYS is empty, raise an error." + + (display `(lookup keys ,keys local-table ,local-table)) (newline) + + (when (null? keys) + (error "KEYS must not be an empty list.")) + + (define (lookup' current-keys current-inner-table-or-value) + "Accept CURRENT-KEYS, a list of symbols, and +CURRENT-INNER-TABLE-OR-VALUE, which may be an inner-table or a value +if CURRENT-KEYS is empty. + +Returns the value associated with the topmost CURRENT-KEYS if at each +level there is a key associated with an inner-table / value. + +Returns #f if one of the keys are not found. + +XXX: Not actually what it does. Update ``in the future''." + + (display `(lookup' current-keys ,current-keys + current-inner-table-or-value ,current-inner-table-or-value)) (newline) + + (if (null? current-keys) + (list current-inner-table-or-value) + (let ([record (assq (car current-keys) + current-inner-table-or-value)]) + (if record + (let* ([result (lookup' (cdr current-keys) + record)] + [result-value (cdr result)]) + (list result-value)) + #f)))) + + + + (let ([result (lookup' keys + (cdr local-table))]) + ;; RESULT is either a (list value) if all keys match, else + ;; an #f. + (if result + (car result) + #f))) + + (define (build-table keys value) + (if (null? keys) + value + (list (cons (car keys) + (build-table (cdr keys) + value))))) + + (define (insert! keys value) + (define (insert!' current-keys current-table) + "CURRENT-KEYS is a list of symbols. CURRENT-TABLE is a cons of (symbol . alist)." + + (let ([record (assq (car current-keys) + (cdr current-table))]) + (display `(insert! record ,record)) (newline) + (if record + (if (null? (cdr current-keys)) + (set-cdr! record value) + (insert!' (cdr current-keys) + record)) + (begin + (set-cdr! current-table + (cons (build-table current-keys + value) + (cdr current-table))))))) + + (insert!' keys local-table) + + 'ok) + + (define (dispatch m) + "Accepts M which is a symbol. Either M is 'lookup, 'insert!, or an +unrecognised symbol - resulting with an error." + (cond + ((eq? m 'lookup) lookup) + ((eq? m 'insert!) insert!) + ((eq? m 'local-table) local-table) + ((eq? m 'build-table) build-table) + (else (error (format #f "Unknown TABLE method: ~a" m))))) + + dispatch)))) diff --git a/sicp/solutions/chapter-3/exercise-26.scm b/sicp/solutions/chapter-3/exercise-26.scm @@ -0,0 +1,43 @@ +(define-library (sicp solutions 3.26) + (import (scheme base)) + + (begin + (define (make-table )) + (define (my-assoc same-key? key table) + (if (null? table) + #f + (let ((record (car table))) + (if (same-key? key (car record)) + record + #f)))) + + (define (make-table same-key?) + (let ((local-table (list '*table*))) + (define (lookup key) + (let ((record (my-assoc same-key? + key + local-table))) + (if record + record + #f))) + + (define (insert! key value) + (let ((record (my-assoc same-key? + key + table))) + (if record + (set-cdr! record + value) + (set-cdr! local-table + (cons (cons key value) + (cdr local-table))))) + + 'ok) + + (define (dispatch m) + (cond + ((eq? m 'lookup) lookup) + ((eq? m 'insert!) insert!) + (else (error "Unknown operation TABLE: " m)))) + + dispatch)))) diff --git a/sicp/solutions/3_3.scm b/sicp/solutions/chapter-3/exercise-3.scm diff --git a/sicp/solutions/3_4.scm b/sicp/solutions/chapter-3/exercise-4.scm diff --git a/sicp/solutions/3_5.scm b/sicp/solutions/chapter-3/exercise-5.scm diff --git a/sicp/solutions/3_6.scm b/sicp/solutions/chapter-3/exercise-6.scm diff --git a/sicp/solutions/3_7.scm b/sicp/solutions/chapter-3/exercise-7.scm diff --git a/sicp/solutions/3_8.scm b/sicp/solutions/chapter-3/exercise-8.scm diff --git a/sicp/solutions/3_9.scm b/sicp/solutions/chapter-3/exercise-9.scm 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 2_40) remove)) + (import (only (sicp solutions chapter-2 exercise-40) remove)) (export decode encode generate-huffman-tree diff --git a/sicp/tests/1_1.scm b/sicp/tests/1_1.scm @@ -1,62 +0,0 @@ -(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/1_21.scm b/sicp/tests/1_21.scm @@ -1,42 +0,0 @@ -(import (srfi :26)) -(import (srfi :64)) -(import (solutions exercise-1.21)) - -(test-begin "prime") -(test-equal '(#t #f #t #f #t #f) (map (cut divides? 2 <>) '(2 3 4 5 6 7))) -(test-equal '(2 3 2 5 2 7) (map smallest-divisor '(2 3 4 5 6 7))) -(test-equal '(#t #t #f #t #f #t) (map prime? '(2 3 4 5 6 7))) -(test-end "prime") - -(test-begin "expmod") -(let ((cases (map (lambda (_) (list (+ 1 (random 100)) - (+ 1 (random 100)))) - (iota 20)))) - (test-equal - (map (lambda (x) (apply (lambda (a n) (= (expmod a - n - n) - a)) - x)) cases) - (map (lambda (x) (apply (lambda (a n) (= (remainder (expt a n) - n) - a)) - x)) - cases))) -(test-end "expmod") - -(test-begin "fast-prime") -(test-equal - (map (lambda (n) (fast-prime? n n)) (iota 100 2)) - (map (cut prime? <>) (iota 100 2))) -(test-end "fast-prime") - -;; XXX - -(test-begin "1.21") -(let ((cases '(199 1999 19999)) - (results '(199 1999 7))) - (test-equal - results - (map (lambda (case) (smallest-divisor case)) cases))) -(test-end "1.21") diff --git a/sicp/tests/1_3.scm b/sicp/tests/1_3.scm @@ -1,11 +0,0 @@ -(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/1_30.scm b/sicp/tests/1_30.scm @@ -1,26 +0,0 @@ -(define-library (sicp tests 1_30) - (import (scheme base)) - (import (srfi :64)) - (import (sicp solutions 1_30)) - - (begin - (test-begin "1.30") - (test-equal - (iterative-sum (lambda (x) (* x x)) - 5 - (lambda (x) (+ 2 x)) - 20) - (linear-recursive-sum (lambda (x) (* x x)) - 5 - (lambda (x) (+ 2 x)) - 20)) - (test-equal - (iterative-sum (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 200) - (linear-recursive-sum (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 200)) - (test-end "1.30"))) diff --git a/sicp/tests/1_31.scm b/sicp/tests/1_31.scm @@ -1,29 +0,0 @@ -(define-library (sicp tests 1_31) - (import (scheme base)) - (import (srfi :1)) - (import (srfi :64)) - (import (sicp solutions 1_31)) - - (begin - (define fac-10 - (reduce * - 1 - (iota 10 1))) - - (test-begin "1.31") - (test-equal - fac-10 - (factorial 10)) - (test-equal - 628 - (floor (* 100 (tau-approximation 1000)))) - (test-equal - (iterative-product (lambda (x) (* x x)) - 1 - (lambda (x) (+ 2 x)) - 10) - (recursive-product (lambda (x) (* x x)) - 1 - (lambda (x) (+ 2 x)) - 10)) - (test-end "1.31"))) diff --git a/sicp/tests/1_32.scm b/sicp/tests/1_32.scm @@ -1,48 +0,0 @@ -(define-library (sicp tests 1_32) - (import (scheme base)) - (import (srfi :64)) - (import (prefix (sicp solutions 1_30) 1_30:)) - (import (prefix (sicp solutions 1_31) 1_31:)) - (import (prefix (sicp solutions 1_32) 1_32:)) - - (begin - (test-begin "1.32") - (test-equal - (1_30:iterative-sum (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20) - (1_32:iterative-sum (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20) - ) - (test-equal - (1_30:iterative-sum (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20) - (1_32:recursive-sum (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20) - ) - (test-equal - (1_31:iterative-product (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20) - (1_32:iterative-product (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20)) - (test-equal - (1_31:iterative-product (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20) - (1_32:recursive-product (lambda (x) (* x x)) - 5 - (lambda (x) (* 2 x)) - 20)) - (test-end "1.32"))) diff --git a/sicp/tests/1_33.scm b/sicp/tests/1_33.scm @@ -1,26 +0,0 @@ -(define-library (sicp tests 1_32) - (import (scheme base)) - (import (srfi :64)) - (import (sicp solutions 1_33)) - - (begin - (test-begin "1.33") - (test-equal - (iterative-filtered-accumulate odd? - + - 0 - (lambda (x) (* x x)) - 0 - (lambda (x) (+ 1 x)) - 100) - (recursive-filtered-accumulate odd? - + - 0 - (lambda (x) (* x x)) - 0 - (lambda (x) (+ 1 x)) - 100)) - (test-equal - (iterative-sum-of-squares 2 100) - (recursive-sum-of-squares 2 100)) - (test-end "1.33"))) diff --git a/sicp/tests/2_33.scm b/sicp/tests/2_33.scm @@ -1,17 +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/2_34.scm b/sicp/tests/2_34.scm @@ -1,15 +0,0 @@ -(import (srfi :64)) -(import (solutions exercise-2.34)) - -(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") diff --git a/sicp/tests/2_35.scm b/sicp/tests/2_35.scm @@ -1,13 +0,0 @@ -(import (srfi :64)) -(import (solutions exercise-2.35)) - -(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") - diff --git a/sicp/tests/2_36.scm b/sicp/tests/2_36.scm @@ -1,11 +0,0 @@ -(import (srfi :64)) -(import (solutions exercise-2.36)) - -(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") diff --git a/sicp/tests/2_40.scm b/sicp/tests/2_40.scm @@ -1,14 +0,0 @@ -(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/2_41.scm b/sicp/tests/2_41.scm @@ -1,20 +0,0 @@ -(import (srfi :64)) -(import (solutions exercise-2.41)) - -(define ratsui - '((3 2 1) - (4 2 1) - (4 3 1) - (4 3 2) - (5 2 1) - (5 3 1) - (5 3 2) - (5 4 1) - (5 4 2) - (5 4 3))) - -(test-begin "2.41") -(test-equal - ratsui - (unique-triples 5)) -(test-end "2.41") diff --git a/sicp/tests/2_42.scm b/sicp/tests/2_42.scm @@ -1,19 +0,0 @@ -(import (srfi :64)) -(import (sicp utils)) -(import (solutions exercise-2.42)) - -(test-begin "2.42") -(test-equal - #f - (safe? 2 - (list (make-position 1 2) - (make-position 2 1)))) -(test-equal - #t - (safe? 2 - (list (make-position 4 2) - (make-position 2 1)))) -(test-equal - '() - (queens 8)) -(test-end "2.42") diff --git a/sicp/tests/2_56.scm b/sicp/tests/2_56.scm @@ -1,41 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 2_56)) - -(test-begin "deriv-stuff") -;; Original: -;; (test-equal -;; '(+ 1 0) -;; (deriv '(+ x 3) 'x)) -;; (test-equal -;; '(+ (* x 0) (* 1 y)) -;; (deriv '(* x y) 'x)) -;; (test-equal -;; '(+ (* (* x -;; y) -;; (+ 1 -;; 0)) -;; (* (+ (* x 0) -;; (* 1 y)) -;; (+ x 3))) -;; (deriv '(* (* x y) (+ x 3)) 'x)) - -;; Simplificating: - -(test-equal - 1 - (deriv '(+ x 3) 'x)) -(test-equal - 'y - (deriv '(* x y) 'x)) -(test-equal - '(+ (* x y) - (* y - (+ x 3))) - (deriv '(* (* x y) (+ x 3)) 'x)) -(test-equal - '(* 3 (** x 2)) - (deriv '(** x 3) 'x)) -(test-equal - '(* -1 (** x -2)) ;; hell oh hell... - (deriv '(** x -1) 'x)) -(test-end "deriv-stuff") diff --git a/sicp/tests/2_61.scm b/sicp/tests/2_61.scm @@ -1,17 +0,0 @@ -(test-begin "2.61") -(test-equal - '(1) - (adjoin-set 1 '())) -(test-equal - '(1) - (adjoin-set 1 '(1))) -(test-equal - '(1 2) - (adjoin-set 1 '(2))) -(test-equal - '(1 2) - (adjoin-set 2 '(1))) -(test-equal - '(1 2 3 4 5 6) - (adjoin-set 3 '(1 2 4 5 6))) -(test-end "2.61") diff --git a/sicp/tests/2_62.scm b/sicp/tests/2_62.scm @@ -1,23 +0,0 @@ -(test-begin "2.62") -(test-equal - '() - (union-set '() '())) -(test-equal - '(1) - (union-set '(1) '())) -(test-equal - '(1) - (union-set '() '(1))) -(test-equal - '(1) - (union-set '(1) '(1))) -(test-equal - '(1 2) - (union-set '(1 2) '(1))) -(test-equal - '(1 2) - (union-set '(1) '(1 2))) -(test-equal - '(1 2 3) - (union-set '(2 3) '(1 2 3))) -(test-end "2.62") diff --git a/sicp/tests/2_67.scm b/sicp/tests/2_67.scm @@ -1,8 +0,0 @@ -(import (srfi :64)) -(import (huffman-codes-stuff)) - -(test-begin "2.67") -(test-equal - '(A D A B B C A) ;; Is this it? Did I fuck any shit up? Manuel de Coding, the Portuguese decoder, agrees with this. - (decode sample-message sample-tree)) -(test-end "2.67") diff --git a/sicp/tests/2_68.scm b/sicp/tests/2_68.scm @@ -1,11 +0,0 @@ -(import (srfi :64)) - -(test-begin "2.68") -(test-equal - sample-message - (encode - (decode sample-message - sample-tree) - sample-tree)) -(test-end "2.68") - diff --git a/sicp/tests/2_7.scm b/sicp/tests/2_7.scm @@ -1,36 +0,0 @@ -(define-library (sicp tests 2_7) - (import (scheme base)) - (import (srfi :64)) - - (begin - ; XXX Break these down to specific solutions and tests. - - (test-begin "2.7") - - (width-interval (add-interval x y)) - (width-interval (make-interval (+ (lower-bound x) - (lower-bound y)) - (+ (upper-bound x) - (upper-bound y)))) - (/ (- (upper-bound (make-interval (+ (lower-bound x) - (lower-bound y)) - (+ (upper-bound x) - (upper-bound y)))) - (lower-bound (make-interval (+ (lower-bound x) - (lower-bound y)) - (+ (upper-bound x) - (upper-bound y))))) - 2) - (/ (- (+ (upper-bound x) - (upper-bound y)) - (+ (lower-bound x) - (lower-bound y))) - 2) - - (add-interval (width-interval x) - (width-interval y)) - (add-interval (/ (- (upper-bound x) (lower-bound x)) 2) - (/ (- (upper-bound y) (lower-bound y)) 2)) - (make-interval ((/ (- (upper-bound x) (lower-bound x)) 2)) - (/ (- (upper-bound y) (lower-bound y)) 2)) - (test-end "2.7"))) diff --git a/sicp/tests/2_73.scm b/sicp/tests/2_73.scm @@ -1,14 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 2_73)) - -(display (deriv '(+ x 1) 'x)) (newline) -(display (deriv '(* (* x x) x) 'x)) (newline) -(display (deriv '(** x 2) 'x)) (newline) - -;; (put 'a 'b map) - -;; (write ((get 'a 'b) 1+ '(1 2 3))) (newline) - -;; (test-begin "2.73") -;; (test-equal 1 1) -;; (test-end "2.73") diff --git a/sicp/tests/2_75.scm b/sicp/tests/2_75.scm @@ -1,17 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 2_75)) - -(test-begin "2.75") -(test-equal - ((make-from-mag-ang 1.0 0.0) 'real-part) - 1.0) -(test-equal - ((make-from-mag-ang 1.0 0.0) 'imag-part) - 0.0) -(test-equal - ((make-from-mag-ang 1.0 0.0) 'magnitude) - 1.0) -(test-equal - ((make-from-mag-ang 1 0.0) 'angle) - 0.0) -(test-end "2.75") diff --git a/sicp/tests/3_1.scm b/sicp/tests/3_1.scm @@ -1,20 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 3_1)) - -(define A (make-accumulator 5)) -(define B (make-accumulator 0)) - -(test-begin "3.1") -(test-equal - 15 - (A 10)) -(test-equal - 10 - (B 10)) -(test-equal - 25 - (A 10)) -(test-equal - 20 - (B 10)) -(test-end "3.1") diff --git a/sicp/tests/3_12.scm b/sicp/tests/3_12.scm @@ -1,50 +0,0 @@ -(define-library (sicp tests 3_12) - (import (scheme base)) - (import (srfi :64)) - (import (only (sicp solutions 3_12) append!)) - - (begin - (define x (list 'a 'b)) - (define y (list 'c 'd)) - (define z (append x y)) - - ;; x: ['a | -]-> ['b | '()] - ;; y: ['c | -]-> ['d | '()] - ;; ^ - ;; | - ;; +----------------+ - ;; | - ;; z: ['a | -]-> ['b | -]--+ - - (test-begin "3.12") - (test-equal - '(a b c d) - z) - (test-equal - '(b) - (cdr x)) - (define w (append! x y)) - - ;; +-------------------+ - ;; | | - ;; v | - ;; x: ['a | -]-> ['b | -]--+ | - ;; | | - ;; +----------------+ | - ;; | | - ;; V | - ;; y: ['c | -]-> ['d | '()] | - ;; ^ | - ;; | | - ;; +----------------+ | - ;; | | - ;; z: ['a | -]-> ['b | -]--+ | - ;; w: ------------------------+ - - (test-equal - '(a b c d) - w) - (test-equal - '(b c d) - (cdr x)) - (test-end "3.12"))) diff --git a/sicp/tests/3_13.scm b/sicp/tests/3_13.scm @@ -1,12 +0,0 @@ -(define-library (sicp tests 3_13) - (import (scheme base)) - (import (only (srfi :1) last-pair)) - (import (srfi :64)) - (import (only (sicp solutions 3_13) make-cycle)) - - (begin - (define z (make-cycle (list 'a 'b 'c))) - - (test-begin "3.13") - (test-error (last-pair z)) ; Guile's last-pair checks for and raises an error on cyclic lists. - (test-end "3.13"))) diff --git a/sicp/tests/3_14.scm b/sicp/tests/3_14.scm @@ -1,212 +0,0 @@ -(define-library (sicp tests 3_14) - (import (scheme base)) - (import (srfi :64)) - - (begin - (test-begin "3.14") - - (define v '(a b c d)) - - ;; v: [a|-]-> [b|-]-> [c|-]-> [d|()] - - ;; iteration 1 - (define y '()) (define x v) - ;; v: [a|-]-> [b|-]-> [c|-]-> [d|()] - ;; ^ - ;; | - ;; x: --+ - ;; y: () - (test-equal '(a b c d) x) - (test-equal '() y) - - (define temp (cdr x)) - ;; v: [a|-]-> [b|-]-> [c|-]-> [d|()] - ;; ^ ^ - ;; | | - ;; x: --+ | - ;; y: () | - ;; temp: -------+ - (test-equal '(b c d) temp) - - (set-cdr! x y) - ;; v: [a|()] [b|-]-> [c|-]-> [d|()] - ;; ^ ^ - ;; | | - ;; x: --+ | - ;; y: () | - ;; temp: -------+ - (test-equal '(a) x) - - ;; iteration 2 - (define y x) (define x temp) - ;; v: [a|()] [b|-]-> [c|-]-> [d|()] - ;; ^ ^ - ;; | | - ;; +-+ | - ;; | | - ;; +------+ - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: ------+ - (test-equal '(b c d) x) - (test-equal '(a) y) - - (define temp (cdr x)) - ;; v: [a|()] [b|-]-> [c|-]-> [d|()] - ;; ^ ^ ^ - ;; | | | - ;; +-+ | | - ;; | | | - ;; +------+ | - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: --------------+ - (test-equal '(c d) temp) - - (set-cdr! x y) - ;; +----------+ - ;; | | - ;; V | - ;; v: [a|()] [b|-]-+ [c|-]-> [d|()] - ;; ^ ^ ^ - ;; | | | - ;; +-+ | | - ;; | | | - ;; +------+ | - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: --------------+ - (test-equal '(b a) x) - - ;; iteration 3 - (define y x) (define x temp) - ;; +----------+ - ;; | | - ;; V | - ;; v: [a|()] [b|-]-+ [c|-]-> [d|()] - ;; ^ ^ - ;; | | - ;; +--------------+ - ;; | | | - ;; | +----+ | - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: --------------+ - (test-equal '(c d) x) - (test-equal '(b a) y) - - (define temp (cdr x)) - ;; +----------+ - ;; | | - ;; V | - ;; v: [a|()] [b|-]-+ [c|-]-> [d|()] - ;; ^ ^ ^ - ;; | | | - ;; +--------------+ | - ;; | | | - ;; | +----+ | - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: ----------------------+ - (test-equal '(d) temp) - - (set-cdr! x y) - ;; +-----------+ - ;; | | - ;; +----------+ | - ;; | | | | - ;; V V | | - ;; v: [a|()] [b|-]-+ [c|-]-+ [d|()] - ;; ^ ^ ^ - ;; | | | - ;; +--------------+ | - ;; | | | - ;; | +----+ | - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: ----------------------+ - (test-equal '(c b a) x) - - ;; iteration 4 - (define y x) (define x temp) - ;; +-----------+ - ;; | | - ;; +----------+ | - ;; | | | | - ;; V V | | - ;; v: [a|()] [b|-]-+ [c|-]-+ [d|()] - ;; ^ ^ - ;; | | - ;; +------------+ | - ;; | | - ;; +----------------------+ - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: ----------------------+ - (test-equal '(d) x) - (test-equal '(c b a) y) - - (define temp (cdr x)) - ;; +-----------+ - ;; | | - ;; +----------+ | - ;; | | | | - ;; V V | | - ;; v: [a|()] [b|-]-+ [c|-]-+ [d|()] - ;; ^ ^ ^ - ;; | | | - ;; +------------+ | | - ;; | | | - ;; +----------------------+ | - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: ------------------------+ - (test-equal '() temp) - - (set-cdr! x y) - ;; +-----------+ - ;; | | - ;; +----------+ +-----------+ - ;; | | | | | | - ;; V V | V | | - ;; v: [a|()] [b|-]-+ [c|-]-+ [d|-]-+ - ;; ^ ^ - ;; | | () - ;; +------------+ | ^ - ;; | | | - ;; +----------------------+ | - ;; | | | - ;; x: --+ | | - ;; y: ----+ | - ;; temp: ------------------------+ - (test-equal '(d c b a) x) - - ;; iteration 5 - (define y x) (define x temp) - ;; +-----------+ - ;; | | - ;; +----------+ +-----------+ - ;; | | | | | | - ;; V V | V | | - ;; v: [a|()] [b|-]-+ [c|-]-+ [d|-]-+ - ;; ^ - ;; | () - ;; | ^ - ;; | | - ;; +--------------------+ | - ;; | | - ;; x: ----|----------------------+ - ;; y: ----+ | - ;; temp: ------------------------+ - (test-equal '() x) - (test-equal '(d c b a) y) - (test-equal '(a) v) - (test-end "3.14"))) diff --git a/sicp/tests/3_15.scm b/sicp/tests/3_15.scm @@ -1,78 +0,0 @@ -(define-library (sicp tests 3_15) - (import (scheme base)) - (import (srfi :64)) - - (begin - (test-begin "3.15") - - (define (set-to-wow! x) - (set-car! (car x) 'wow) - x) - - (define x (list 'a 'b)) - (define z1 (cons x x)) - (define z2 (cons (list 'a 'b) - (list 'a 'b))) - ;; +---+---+ - ;; z1: --> | * | * | - ;; +-|-+-|-+ - ;; V V - ;; +---+---+ +---+---+ - ;; x: --> | * | *-+---->| * | / | - ;; +-|-+---+ +-|-+---+ - ;; V V - ;; +---+ +---+ - ;; | a | | b | - ;; +---+ +---+ - ;; - ;; +---+---+ +---+---+ +---+---+ - ;; z2: --> | * | * +---->| * | *-+--->| * | / | - ;; +-|-+---+ +-|-+---+ +-|-+---+ - ;; | V V - ;; | +---+ +---+ - ;; | | a | | b | - ;; | +---+ +---+ - ;; | ^ ^ - ;; | | | - ;; | +-|-+---+ +-|-+---+ - ;; +---------->| * | *-+--->| * | / | - ;; +---+---+ +---+---+ - (test-equal '(a b) x) - (test-equal '((a b) a b) z1) - (test-equal '((a b) a b) z2) - - (set-to-wow! z1) - (set-to-wow! z2) - ;; +---+---+ - ;; z1: --> | * | * | - ;; +-|-+-|-+ - ;; V V - ;; +---+---+ +---+---+ - ;; x: --> | * | *-+---->| * | / | - ;; +-|-+---+ +-|-+---+ - ;; V V - ;; +-----+ +---+ - ;; | wow | | b | - ;; +-----+ +---+ - ;; - ;; +---+---+ +---+---+ +---+---+ - ;; z2: --> | * | * +---->| * | *-+--->| * | / | - ;; +-|-+---+ +-|-+---+ +-|-+---+ - ;; | V V - ;; | +---+ +---+ - ;; | | a | | b | - ;; | +---+ +---+ - ;; | ^ - ;; | +-----+ | - ;; | | wow | | - ;; | +-----+ | - ;; | ^ | - ;; | | | - ;; | +-|-+---+ +-|-+---+ - ;; +---------->| * | *-+--->| * | / | - ;; +---+---+ +---+---+ - (test-equal '(wow b) x) - (test-equal '((wow b) wow b) z1) - (test-equal '((wow b) a b) z2) - - (test-end "3.15"))) diff --git a/sicp/tests/3_16.scm b/sicp/tests/3_16.scm @@ -1,83 +0,0 @@ -(define-library (sicp tests 3_16) - (import (scheme base)) - (import (srfi :64)) - - (begin - (test-begin "3.16") - - (define (count-pairs x) - (if (not (pair? x)) - 0 - (+ (count-pairs (car x)) - (count-pairs (cdr x)) - 1))) - - (define three-pairs '(1 2 3)) - - (define four-pairs - (let ([a (list 1 2)] - [b (list 3)]) - (set-car! (cdr a) b) - (set-cdr! (cdr a) b) - a)) - - (define seven-pairs - (let ([a (list 1)] - [b (list 2)] - [c (list 3)]) - (set-car! a b) - (set-cdr! a b) - (set-car! b c) - (set-cdr! b c) - a)) - - ;; +---+---+ +---+---+ +---+---+ - ;; three-pairs: | 1 | *-+-->| 2 | *-+-->| 3 | * | - ;; +---+---+ +---+---+ +---+---+ - - ;; +---+---+ +---+---+ +---+---+ - ;; four-pairs: | 1 | *-+-->| * | *-+-->| 3 | * | - ;; +---+---+ +-+-+---+ +---+---+ - ;; | ^ - ;; | | - ;; +-------------+ - - ;; +---+---+ +---+---+ +---+---+ - ;; seven-pairs: | * | *-+-->| * | *-+-->| 3 | * | - ;; +-+-+---+ +-+-+---+ +---+---+ - ;; | | ^ ^ - ;; | | | | - ;; +-----------|-+ | - ;; | | - ;; +-------------+ - - (test-equal - '(1 2 3) - three-pairs) - - (test-equal - (cons 1 - (cons (cons 3 '()) - (cons 3 '()))) - four-pairs) - - (test-equal - (cons (cons (cons 3 '()) - (cons 3 '())) - (cons (cons 3 '()) - (cons 3 '()))) - seven-pairs) - - (test-equal - 3 - (count-pairs three-pairs)) - - (test-equal - 4 - (count-pairs four-pairs)) - - (test-equal - 7 - (count-pairs seven-pairs)) - - (test-end "3.16"))) diff --git a/sicp/tests/3_17.scm b/sicp/tests/3_17.scm @@ -1,40 +0,0 @@ -(define-library (sicp tests 3_17) - (import (scheme base)) - (import (srfi :64)) - (import (only (sicp solutions 3_17) count-pairs)) - - (begin - (test-begin "3.17") - - (define three-pairs '(1 2 3)) - - (test-equal - 3 - (count-pairs three-pairs)) - - (define four-pairs - (let ([a (list 1 2)] - [b (list 3)]) - (set-car! (cdr a) b) - (set-cdr! (cdr a) b) - a)) - - (test-equal - 3 - (count-pairs four-pairs)) - - (define seven-pairs - (let ([a (list 1)] - [b (list 2)] - [c (list 3)]) - (set-car! a b) - (set-cdr! a b) - (set-car! b c) - (set-cdr! b c) - a)) - - (test-equal - 3 - (count-pairs seven-pairs)) - - (test-end "3.17"))) diff --git a/sicp/tests/3_18.scm b/sicp/tests/3_18.scm @@ -1,25 +0,0 @@ -(define-library (sicp tests 3_18) - (import (scheme base)) - (import (srfi :1)) - (import (srfi :64)) - (import (only (sicp solutions 3_18) cyclic?)) - - (begin - (test-begin "3.18") - - (define a (list 1 2 3)) - - (define b - (let ([a (list 1 2 3)]) - (set-cdr! (last-pair a) a) - a)) - - (test-equal - #f - (cyclic? a)) - - (test-equal - #t - (cyclic? b)) - - (test-end "3.18"))) diff --git a/sicp/tests/3_19.scm b/sicp/tests/3_19.scm @@ -1,50 +0,0 @@ -(define-library (sicp tests 3_19) - (import (scheme base)) - (import (srfi :1)) - (import (srfi :64)) - (import (only (sicp solutions 3_19) cyclic?)) - - (begin - (test-begin "3.19") - - (define (make-cyclic lst) - (set-cdr! (last-pair lst) lst) - lst) - - (test-equal - #f - (cyclic? '())) - - (test-equal - #f - (cyclic? '(1))) - - (test-equal - #f - (cyclic? '(1 2))) - - (test-equal - #f - (cyclic? '(1 2 3))) - - (test-equal - #t - (cyclic? - (make-cyclic (list 1)))) - - (test-equal - #t - (cyclic? - (make-cyclic (list 1 2)))) - - (test-equal - #t - (cyclic? - (make-cyclic (list 1 2 3)))) - - (test-equal - #t - (cyclic? - (make-cyclic (list 1 2 3 4)))) - - (test-end "3.19"))) diff --git a/sicp/tests/3_2.scm b/sicp/tests/3_2.scm @@ -1,29 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 3_2)) - -(define s (make-monitored sqrt)) - -(test-begin "3.2") -(test-equal - 0 - (s 'how-many-calls?)) -(test-equal - 10 - (s 100)) -(test-equal - 1 - (s 'how-many-calls?)) -(s 100) -(s 100) -(test-equal - 3 - (s 'how-many-calls?)) -(s 'reset-count) -(s 100) -(s 100) -(s 100) -(s 100) -(test-equal - 4 - (s 'how-many-calls?)) -(test-end "3.2") diff --git a/sicp/tests/3_21.scm b/sicp/tests/3_21.scm @@ -1,74 +0,0 @@ -(define-library (sicp tests 3_21) - (import (scheme base)) - (import (scheme write)) - (import (srfi :64)) - (import (sicp solutions 3_21)) - - (begin - (test-begin "3.21") - - (define (test-equal-print-queue string-ratsui queue-matsui) - (define string-port (open-output-string)) - - (print-queue queue-matsui string-port) - - (define string-matsui - (get-output-string string-port)) - - (test-equal string-ratsui string-matsui)) - - (define q1 (make-queue)) - (test-equal '(()) q1) - (test-equal-print-queue "()" q1) - - (insert-queue! q1 'a) - (test-equal '((a) a) q1) - (test-equal-print-queue "(a)" q1) - - (insert-queue! q1 'b) - (test-equal '((a b) b) q1) - (test-equal-print-queue "(a b)" q1) - - (insert-queue! q1 'c) - (test-equal '((a b c) c) q1) - (test-equal-print-queue "(a b c)" q1) - - (insert-queue! q1 'd) - (test-equal '((a b c d) d) q1) - (test-equal-print-queue "(a b c d)" q1) - - (delete-queue! q1) - (test-equal '((b c d) d) q1) - (test-equal-print-queue "(b c d)" q1) - - (delete-queue! q1) - (test-equal '((c d) d) q1) - (test-equal-print-queue "(c d)" q1) - - (delete-queue! q1) - (test-equal '((d) d) q1) - (test-equal-print-queue "(d)" q1) - - (delete-queue! q1) - (test-equal '(() d) q1) - (test-equal-print-queue "()" q1) - - ;; When one display the queue, without a special procedure, one - ;; sees the a tree where the first element is the list of items - ;; sorted from first item insert to last item insert to the queue, - ;; and the second item is the last item inserted to the queue, - ;; whether if the queue is empty or not. - ;; ((first-item-inserted second-item-inserted ...) last-item-inserted) - ;; or - ;; (() last-item-inserted) - - ;; One can see the last item inserted to the queue right after the - ;; only item in it is deleted because the rear pointer of the - ;; queue does not change which object it points at when - ;; delete-queue! is used when there is only one item in the - ;; queue. It does not need to change because when the queue is - ;; empty and then a new item is inserted, a new (cons item '()) is - ;; created, and both the front and rear pointers are pointed at - ;; it. - - (test-end "3.21"))) diff --git a/sicp/tests/3_22.scm b/sicp/tests/3_22.scm @@ -1,47 +0,0 @@ -(define-library (sicp tests 3_22) - (import (scheme base)) - (import (scheme write)) - (import (srfi :64)) - (import (sicp solutions 3_22)) - - (begin - (test-begin "3.22") - - (define (test-equal-print-queue string-ratsui queue-matsui) - (define string-port (open-output-string)) - - ((queue-matsui 'print-queue) string-port) - - (define string-matsui - (get-output-string string-port)) - - (test-equal string-ratsui string-matsui)) - - (define q1 (make-queue)) - (test-equal-print-queue "()" q1) - - ((q1 'insert-queue!) 'a) - (test-equal-print-queue "(a)" q1) - - ((q1 'insert-queue!) 'b) - (test-equal-print-queue "(a b)" q1) - - ((q1 'insert-queue!) 'c) - (test-equal-print-queue "(a b c)" q1) - - ((q1 'insert-queue!) 'd) - (test-equal-print-queue "(a b c d)" q1) - - ((q1 'delete-queue!)) - (test-equal-print-queue "(b c d)" q1) - - ((q1 'delete-queue!)) - (test-equal-print-queue "(c d)" q1) - - ((q1 'delete-queue!)) - (test-equal-print-queue "(d)" q1) - - ((q1 'delete-queue!)) - (test-equal-print-queue "()" q1) - - (test-end "3.22"))) diff --git a/sicp/tests/3_23.scm b/sicp/tests/3_23.scm @@ -1,173 +0,0 @@ -(define-library (sicp tests 3_23) - (import (scheme base)) - (import (scheme write)) - - (import (srfi :64)) - - (import (sicp solutions 3_23 3_23)) - - (begin - (test-begin "3.23") - - (define (test-equal-print-deque string-ratsui deque-matsui) - (define string-port (open-output-string)) - - (print-deque deque-matsui string-port) - - (print-deque deque-matsui) (newline) - - (define string-matsui - (get-output-string string-port)) - - (test-equal string-ratsui string-matsui)) - - (define q1 (make-deque)) - (test-equal-print-deque "()" q1) - (test-error (front-deque q1)) - (test-error (rear-deque q1)) - - (rear-insert-deque! q1 1) - (test-equal-print-deque "(1)" q1) - (test-equal - 1 - (front-deque q1)) - (test-equal - 1 - (rear-deque q1)) - - (rear-insert-deque! q1 2) - (test-equal-print-deque "(1 2)" q1) - (test-equal - 1 - (front-deque q1)) - (test-equal - 2 - (rear-deque q1)) - - (rear-insert-deque! q1 3) - (test-equal-print-deque "(1 2 3)" q1) - (test-equal - 1 - (front-deque q1)) - (test-equal - 3 - (rear-deque q1)) - - (rear-insert-deque! q1 4) - (test-equal-print-deque "(1 2 3 4)" q1) - (test-equal - 1 - (front-deque q1)) - (test-equal - 4 - (rear-deque q1)) - - - (front-delete-deque! q1) - (test-equal-print-deque "(2 3 4)" q1) - (test-equal - 2 - (front-deque q1)) - (test-equal - 4 - (rear-deque q1)) - - - (front-delete-deque! q1) - (test-equal-print-deque "(3 4)" q1) - (test-equal - 3 - (front-deque q1)) - (test-equal - 4 - (rear-deque q1)) - - - (front-delete-deque! q1) - (test-equal-print-deque "(4)" q1) - (test-equal - 4 - (front-deque q1)) - (test-equal - 4 - (rear-deque q1)) - - - - (front-delete-deque! q1) - (test-equal-print-deque "()" q1) - (test-error - (front-deque q1)) - (test-error - (rear-deque q1)) - - (front-insert-deque! q1 1) - (test-equal-print-deque "(1)" q1) - (test-equal - 1 - (front-deque q1)) - (test-equal - 1 - (rear-deque q1)) - - (front-insert-deque! q1 2) - (test-equal-print-deque "(2 1)" q1) - (test-equal - 2 - (front-deque q1)) - (test-equal - 1 - (rear-deque q1)) - - (front-insert-deque! q1 3) - (test-equal-print-deque "(3 2 1)" q1) - (test-equal - 3 - (front-deque q1)) - (test-equal - 1 - (rear-deque q1)) - - (front-insert-deque! q1 4) - (test-equal-print-deque "(4 3 2 1)" q1) - (test-equal - 4 - (front-deque q1)) - (test-equal - 1 - (rear-deque q1)) - - (rear-delete-deque! q1) - (test-equal-print-deque "(4 3 2)" q1) - (test-equal - 4 - (front-deque q1)) - (test-equal - 2 - (rear-deque q1)) - - (rear-delete-deque! q1) - (test-equal-print-deque "(4 3)" q1) - (test-equal - 4 - (front-deque q1)) - (test-equal - 3 - (rear-deque q1)) - - (rear-delete-deque! q1) - (test-equal-print-deque "(4)" q1) - (test-equal - 4 - (front-deque q1)) - (test-equal - 4 - (rear-deque q1)) - - (rear-delete-deque! q1) - (test-equal-print-deque "()" q1) - (test-error (front-deque q1)) - (test-error (rear-deque q1)) - - - (test-end "3.23"))) diff --git a/sicp/tests/3_3.scm b/sicp/tests/3_3.scm @@ -1,14 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 3_3)) - -(define acc - (make-account 100 'secret-password)) - -(test-begin "3.3") -(test-equal - 60 - ((acc 'secret-password 'withdraw) 40)) -(test-equal - "Incorrect password" - ((acc 'some-other-password 'deposit) 50)) -(test-end "3.3") diff --git a/sicp/tests/3_4.scm b/sicp/tests/3_4.scm @@ -1,38 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 3_4)) - -(define acc - (make-account 100 'secret-password)) - -(test-begin "3.4") -(test-equal - 60 - ((acc 'secret-password 'withdraw) 40)) -(test-equal - "Incorrect password" - ((acc 'some-other-password 'deposit) 50)) -(test-equal - "Incorrect password" - ((acc 'some-other-password 'deposit) 50)) -(test-equal - "Incorrect password" - ((acc 'some-other-password 'deposit) 50)) -(test-equal - "Incorrect password" - ((acc 'some-other-password 'deposit) 50)) -(test-equal - "Incorrect password" - ((acc 'some-other-password 'deposit) 50)) -(test-equal - "Incorrect password" - ((acc 'some-other-password 'deposit) 50)) -(test-equal -"Cops called." - ((acc 'some-other-password 'deposit) 50)) -(test-equal -"Cops called." - ((acc 'some-other-password 'deposit) 50)) -(test-equal -"Cops called." - ((acc 'some-other-password 'deposit) 50)) -(test-end "3.4") diff --git a/sicp/tests/3_6.scm b/sicp/tests/3_6.scm @@ -1,22 +0,0 @@ -(import (srfi :64)) -(import (sicp solutions 3_6)) - -(rand 'reset 0) - -(define random-sequence-a - (map - (lambda (x) (rand 'generate)) - (iota 10))) - -(rand 'reset 0) - -(define random-sequence-b - (map - (lambda (x) (rand 'generate)) - (iota 10))) - -(test-begin "3.6") -(test-equal - random-sequence-a - random-sequence-b) -(test-end "3.6") diff --git a/sicp/tests/3_7.scm b/sicp/tests/3_7.scm @@ -1,27 +0,0 @@ -(define-library (sicp tests 3_7) - (import (scheme base)) - (import (scheme write)) - (import (srfi :64)) - (import (only (sicp solutions 3_3) make-account)) - (import (sicp solutions 3_7)) - - (begin - (define acc - (make-account 100 - 'secret-password)) - - (define joint-acc (make-joint acc - 'secret-password - 'another-secret-password)) - - (test-begin "3.7") - (test-equal - 60 - ((acc 'secret-password 'withdraw) 40)) - (test-equal - "Incorrect password" - ((acc 'incorrect-password 'deposit) 50)) - (test-equal - 110 - ((joint-acc 'another-secret-password 'deposit) 50)) - (test-end "3.7"))) diff --git a/sicp/tests/3_8.scm b/sicp/tests/3_8.scm @@ -1,16 +0,0 @@ -(define-library (sicp tests 3_8) - (import (scheme base)) - (import (srfi srfi-64)) - (import (only (sicp solutions 3_8) make-f)) - - (begin - (define f (make-f)) - - (test-begin "3.8") - (test-equal - 1 ; Turns out it starts with the right one. - ;; People of #scheme @ libera.chat say it is an implementation detail. - ;; The specification leaves the order of evaluation unspecified, - ;; and therefore one should avoid writing code that depends on it. - (+ (f 0) (f 1))) - (test-end "3.8"))) diff --git a/sicp/tests/chapter-1/exercise-1.scm b/sicp/tests/chapter-1/exercise-1.scm @@ -0,0 +1,67 @@ +(define-library (sicp tests chapter-1 exercise-1) + (import + (scheme base) + (sicp solutions chapter-1 exercise-1) + (srfi srfi-64)) + + (begin + (test-begin "chapter-1-exercise-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 "chapter-1-exercise-1"))) diff --git a/sicp/tests/chapter-1/exercise-21.scm b/sicp/tests/chapter-1/exercise-21.scm @@ -0,0 +1,48 @@ +(define-library (sicp tests chapter-1 exercise-21) + (import + (scheme base) + (srfi :1) + (srfi :26) + (srfi :64) + (only (guile) random) + (sicp solutions chapter-1 exercise-21) + ) + + (begin + (test-begin "chapter-1-exercise-21") + (test-group "prime" + (test-equal '(#t #f #t #f #t #f) (map (cut divides? 2 <>) '(2 3 4 5 6 7))) + (test-equal '(2 3 2 5 2 7) (map smallest-divisor '(2 3 4 5 6 7))) + (test-equal '(#t #t #f #t #f #t) (map prime? '(2 3 4 5 6 7)))) + + (test-group "expmod" + (let ((cases (map (lambda (_) (list (+ 1 (random 100)) + (+ 1 (random 100)))) + (iota 20)))) + (test-equal + (map (lambda (x) (apply (lambda (a n) (= (expmod a + n + n) + a)) + x)) cases) + (map (lambda (x) (apply (lambda (a n) (= (remainder (expt a n) + n) + a)) + x)) + cases)))) + + (test-group "fast-prime" + (test-equal + (map (lambda (n) (fast-prime? n n)) (iota 100 2)) + (map (cut prime? <>) (iota 100 2)))) + + ;; XXX + + + (test-group "1.21" + (let ((cases '(199 1999 19999)) + (results '(199 1999 7))) + (test-equal + results + (map (lambda (case) (smallest-divisor case)) cases)))) + (test-end "chapter-1-exercise-21"))) diff --git a/sicp/tests/chapter-1/exercise-3.scm b/sicp/tests/chapter-1/exercise-3.scm @@ -0,0 +1,16 @@ +(define-library (sicp tests chapter-1 exercise-3) + (import + (scheme base) + (srfi :64) + (only (sicp solutions chapter-1 exercise-3) + sum-of-squares-of-two-largest-out-of-three)) + + (begin + (test-begin "chapter-1-exercise-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 "chapter-1-exercise-3"))) diff --git a/sicp/tests/chapter-1/exercise-30.scm b/sicp/tests/chapter-1/exercise-30.scm @@ -0,0 +1,26 @@ +(define-library (sicp tests chapter-1 exercise-30) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-1 exercise-30)) + + (begin + (test-begin "chapter-1-exercise-30") + (test-equal + (iterative-sum (lambda (x) (* x x)) + 5 + (lambda (x) (+ 2 x)) + 20) + (linear-recursive-sum (lambda (x) (* x x)) + 5 + (lambda (x) (+ 2 x)) + 20)) + (test-equal + (iterative-sum (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 200) + (linear-recursive-sum (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 200)) + (test-end "chapter-1-exercise-30"))) diff --git a/sicp/tests/chapter-1/exercise-31.scm b/sicp/tests/chapter-1/exercise-31.scm @@ -0,0 +1,29 @@ +(define-library (sicp tests chapter-1 exercise-31) + (import (scheme base)) + (import (srfi :1)) + (import (srfi :64)) + (import (sicp solutions chapter-1 exercise-31)) + + (begin + (define fac-10 + (reduce * + 1 + (iota 10 1))) + + (test-begin "chapter-1-exercise-31") + (test-equal + fac-10 + (factorial 10)) + (test-equal + 628 + (floor (* 100 (tau-approximation 1000)))) + (test-equal + (iterative-product (lambda (x) (* x x)) + 1 + (lambda (x) (+ 2 x)) + 10) + (recursive-product (lambda (x) (* x x)) + 1 + (lambda (x) (+ 2 x)) + 10)) + (test-end "chapter-1-exercise-31"))) diff --git a/sicp/tests/chapter-1/exercise-32.scm b/sicp/tests/chapter-1/exercise-32.scm @@ -0,0 +1,48 @@ +(define-library (sicp tests chapter-1 exercise-32) + (import (scheme base)) + (import (srfi :64)) + (import (prefix (sicp solutions chapter-1 exercise-30) 1_30:)) + (import (prefix (sicp solutions chapter-1 exercise-31) 1_31:)) + (import (prefix (sicp solutions chapter-1 exercise-32) 1_32:)) + + (begin + (test-begin "chapter-1-exercise-32") + (test-equal + (1_30:iterative-sum (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20) + (1_32:iterative-sum (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20) + ) + (test-equal + (1_30:iterative-sum (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20) + (1_32:recursive-sum (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20) + ) + (test-equal + (1_31:iterative-product (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20) + (1_32:iterative-product (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20)) + (test-equal + (1_31:iterative-product (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20) + (1_32:recursive-product (lambda (x) (* x x)) + 5 + (lambda (x) (* 2 x)) + 20)) + (test-end "chapter-1-exercise-32"))) diff --git a/sicp/tests/chapter-1/exercise-33.scm b/sicp/tests/chapter-1/exercise-33.scm @@ -0,0 +1,26 @@ +(define-library (sicp tests chapter-1 exercise-32) + (import (scheme base)) + (import (srfi :64)) + (import (sicp solutions chapter-1 exercise-33)) + + (begin + (test-begin "chapter-1-exercise-33") + (test-equal + (iterative-filtered-accumulate odd? + + + 0 + (lambda (x) (* x x)) + 0 + (lambda (x) (+ 1 x)) + 100) + (recursive-filtered-accumulate odd? + + + 0 + (lambda (x) (* x x)) + 0 + (lambda (x) (+ 1 x)) + 100)) + (test-equal + (iterative-sum-of-squares 2 100) + (recursive-sum-of-squares 2 100)) + (test-end "chapter-1-exercise-33"))) diff --git a/sicp/tests/chapter-2/exercise-33.scm b/sicp/tests/chapter-2/exercise-33.scm @@ -0,0 +1,20 @@ +(define-library (sicp tests chapter-2 exercise-33) + (import (scheme base) + (srfi :64) + (sicp utils) + (sicp solutions chapter-2 exercise-33)) + + (begin + (test-begin "chapter-2-exercise-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 "chapter-2-exercise-33"))) diff --git a/sicp/tests/chapter-2/exercise-34.scm b/sicp/tests/chapter-2/exercise-34.scm @@ -0,0 +1,18 @@ +(define-library (sicp tests chapter-2 exercise-34) + (import (scheme base) + (srfi :64)) + (import (sicp solutions chapter-2 exercise-34)) + + (begin + (test-begin "chapter-2-exercise-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 "chapter-2-exercise-34"))) diff --git a/sicp/tests/chapter-2/exercise-35.scm b/sicp/tests/chapter-2/exercise-35.scm @@ -0,0 +1,13 @@ +(define-library (sicp tests chapter-2 exercise-35) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-2 exercise-35)) + (begin + (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"))) diff --git a/sicp/tests/chapter-2/exercise-36.scm b/sicp/tests/chapter-2/exercise-36.scm @@ -0,0 +1,14 @@ +(define-library (sicp tests chapter-2 exercise-36) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-2 exercise-36)) + + (begin + (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"))) diff --git a/sicp/tests/chapter-2/exercise-40.scm b/sicp/tests/chapter-2/exercise-40.scm @@ -0,0 +1,16 @@ +(define-library (sicp tests chapter-2 exercise-40) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-2 exercise-40)) + + (begin + (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/chapter-2/exercise-41.scm b/sicp/tests/chapter-2/exercise-41.scm @@ -0,0 +1,23 @@ +(define-library (sicp tests chapter-2 exercise-41) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-2 exercise-41)) + + (begin + (define ratsui + '((3 2 1) + (4 2 1) + (4 3 1) + (4 3 2) + (5 2 1) + (5 3 1) + (5 3 2) + (5 4 1) + (5 4 2) + (5 4 3))) + + (test-begin "2.41") + (test-equal + ratsui + (unique-triples 5)) + (test-end "2.41"))) diff --git a/sicp/tests/chapter-2/exercise-42.scm b/sicp/tests/chapter-2/exercise-42.scm @@ -0,0 +1,22 @@ +(define-library (sicp tests chapter-2 exercise-42) + (import (scheme base) + (srfi :64) + (sicp utils) + (sicp solutions chapter-2 exercise-42)) + + (begin + (test-begin "chapter-2-exercise-42") + (test-equal + #f + (safe? 2 + (list (make-position 1 2) + (make-position 2 1)))) + (test-equal + #t + (safe? 2 + (list (make-position 4 2) + (make-position 2 1)))) + (test-equal + '() + (queens 8)) + (test-end "chapter-2-exercise-42"))) diff --git a/sicp/tests/chapter-2/exercise-56.scm b/sicp/tests/chapter-2/exercise-56.scm @@ -0,0 +1,44 @@ +(define-library (sicp tests chapter-2 exercise-56) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-2 exercise-56)) + + (begin + (test-begin "deriv-stuff") + ;; Original: + ;; (test-equal + ;; '(+ 1 0) + ;; (deriv '(+ x 3) 'x)) + ;; (test-equal + ;; '(+ (* x 0) (* 1 y)) + ;; (deriv '(* x y) 'x)) + ;; (test-equal + ;; '(+ (* (* x + ;; y) + ;; (+ 1 + ;; 0)) + ;; (* (+ (* x 0) + ;; (* 1 y)) + ;; (+ x 3))) + ;; (deriv '(* (* x y) (+ x 3)) 'x)) + + ;; Simplificating: + + (test-equal + 1 + (deriv '(+ x 3) 'x)) + (test-equal + 'y + (deriv '(* x y) 'x)) + (test-equal + '(+ (* x y) + (* y + (+ x 3))) + (deriv '(* (* x y) (+ x 3)) 'x)) + (test-equal + '(* 3 (** x 2)) + (deriv '(** x 3) 'x)) + (test-equal + '(* -1 (** x -2)) ;; hell oh hell... + (deriv '(** x -1) 'x)) + (test-end "deriv-stuff"))) diff --git a/sicp/tests/chapter-2/exercise-61.scm b/sicp/tests/chapter-2/exercise-61.scm @@ -0,0 +1,22 @@ +(define-library (sicp tests chapter-2 exercise-61) + (import (scheme base) + (srfi :64)) + + (begin + (test-begin "2.61") + (test-equal + '(1) + (adjoin-set 1 '())) + (test-equal + '(1) + (adjoin-set 1 '(1))) + (test-equal + '(1 2) + (adjoin-set 1 '(2))) + (test-equal + '(1 2) + (adjoin-set 2 '(1))) + (test-equal + '(1 2 3 4 5 6) + (adjoin-set 3 '(1 2 4 5 6))) + (test-end "2.61"))) diff --git a/sicp/tests/chapter-2/exercise-62.scm b/sicp/tests/chapter-2/exercise-62.scm @@ -0,0 +1,28 @@ +(define-library (sicp tests chapter-2 exercise-62) + (import (scheme base) + (srfi :64)) + + (begin + (test-begin "chapter-2-exercise-62") + (test-equal + '() + (union-set '() '())) + (test-equal + '(1) + (union-set '(1) '())) + (test-equal + '(1) + (union-set '() '(1))) + (test-equal + '(1) + (union-set '(1) '(1))) + (test-equal + '(1 2) + (union-set '(1 2) '(1))) + (test-equal + '(1 2) + (union-set '(1) '(1 2))) + (test-equal + '(1 2 3) + (union-set '(2 3) '(1 2 3))) + (test-end "chapter-2-exercise-62"))) diff --git a/sicp/tests/chapter-2/exercise-67.scm b/sicp/tests/chapter-2/exercise-67.scm @@ -0,0 +1,12 @@ +(define-library (sicp tests chapter-2 exercise-67) + (import (scheme base) + (srfi :64) + (sicp solutions huffman-codes-stuff)) + + (begin + (test-begin "2.67") + (test-equal + '(A D A B B C A) ;; Is this it? Did I fuck any shit up? Manuel de Coding, the Portuguese decoder, agrees with this. + (decode sample-message sample-tree)) + (test-end "2.67") + )) diff --git a/sicp/tests/chapter-2/exercise-68.scm b/sicp/tests/chapter-2/exercise-68.scm @@ -0,0 +1,15 @@ +(define-library (sicp tests chapter-2 exercise-68) + (import (scheme base) + (srfi :64) + (sicp solutions huffman-codes-stuff)) + + (begin + (test-begin "2.68") + (test-equal + sample-message + (encode + (decode sample-message + sample-tree) + sample-tree)) + (test-end "2.68"))) + diff --git a/sicp/tests/2_69.scm b/sicp/tests/chapter-2/exercise-69.scm diff --git a/sicp/tests/chapter-2/exercise-7.scm b/sicp/tests/chapter-2/exercise-7.scm @@ -0,0 +1,37 @@ +(define-library (sicp tests chapter-2 exercise-7) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-2 exercise-7)) + + (begin + ; XXX Break these down to specific solutions and tests. + + (test-begin "chapter-2-exercise-7") + + (width-interval (add-interval x y)) + (width-interval (make-interval (+ (lower-bound x) + (lower-bound y)) + (+ (upper-bound x) + (upper-bound y)))) + (/ (- (upper-bound (make-interval (+ (lower-bound x) + (lower-bound y)) + (+ (upper-bound x) + (upper-bound y)))) + (lower-bound (make-interval (+ (lower-bound x) + (lower-bound y)) + (+ (upper-bound x) + (upper-bound y))))) + 2) + (/ (- (+ (upper-bound x) + (upper-bound y)) + (+ (lower-bound x) + (lower-bound y))) + 2) + + (add-interval (width-interval x) + (width-interval y)) + (add-interval (/ (- (upper-bound x) (lower-bound x)) 2) + (/ (- (upper-bound y) (lower-bound y)) 2)) + (make-interval ((/ (- (upper-bound x) (lower-bound x)) 2)) + (/ (- (upper-bound y) (lower-bound y)) 2)) + (test-end "chapter-2-exercise-7"))) diff --git a/sicp/tests/2_70.scm b/sicp/tests/chapter-2/exercise-70.scm diff --git a/sicp/tests/2_71.scm b/sicp/tests/chapter-2/exercise-71.scm diff --git a/sicp/tests/2_72.scm b/sicp/tests/chapter-2/exercise-72.scm diff --git a/sicp/tests/chapter-2/exercise-73.scm b/sicp/tests/chapter-2/exercise-73.scm @@ -0,0 +1,19 @@ +(define-library (sicp tests chapter-2 exercise-73) + (import (scheme base) + (scheme write) + (srfi :64) + (sicp solutions chapter-2 exercise-73)) + + (begin + (display (deriv '(+ x 1) 'x)) (newline) + (display (deriv '(* (* x x) x) 'x)) (newline) + (display (deriv '(** x 2) 'x)) (newline) + + ;; (put 'a 'b map) + + ;; (write ((get 'a 'b) 1+ '(1 2 3))) (newline) + + ;; (test-begin "2.73") + ;; (test-equal 1 1) + ;; (test-end "2.73") + )) diff --git a/sicp/tests/chapter-2/exercise-75.scm b/sicp/tests/chapter-2/exercise-75.scm @@ -0,0 +1,20 @@ +(define-library (sicp tests chapter-2 exercise-75) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-2 exercise-75))) + +(begin + (test-begin "2.75") + (test-equal + ((make-from-mag-ang 1.0 0.0) 'real-part) + 1.0) + (test-equal + ((make-from-mag-ang 1.0 0.0) 'imag-part) + 0.0) + (test-equal + ((make-from-mag-ang 1.0 0.0) 'magnitude) + 1.0) + (test-equal + ((make-from-mag-ang 1 0.0) 'angle) + 0.0) + (test-end "2.75")) diff --git a/sicp/tests/chapter-3/exercise-1.scm b/sicp/tests/chapter-3/exercise-1.scm @@ -0,0 +1,23 @@ +(define-library (sicp tests chapter-3 exercise-1) + (import (scheme base) + (srfi :64) + (sicp solutions 3_1)) + + (begin + (define A (make-accumulator 5)) + (define B (make-accumulator 0)) + + (test-begin "3.1") + (test-equal + 15 + (A 10)) + (test-equal + 10 + (B 10)) + (test-equal + 25 + (A 10)) + (test-equal + 20 + (B 10)) + (test-end "3.1"))) diff --git a/sicp/tests/chapter-3/exercise-12.scm b/sicp/tests/chapter-3/exercise-12.scm @@ -0,0 +1,50 @@ +(define-library (sicp tests chapter-3 exercise-12) + (import (scheme base) + (srfi :64) + (only (sicp solutions chapter-3 exercise-12) append!)) + + (begin + (define x (list 'a 'b)) + (define y (list 'c 'd)) + (define z (append x y)) + + ;; x: ['a | -]-> ['b | '()] + ;; y: ['c | -]-> ['d | '()] + ;; ^ + ;; | + ;; +----------------+ + ;; | + ;; z: ['a | -]-> ['b | -]--+ + + (test-begin "3.12") + (test-equal + '(a b c d) + z) + (test-equal + '(b) + (cdr x)) + (define w (append! x y)) + + ;; +-------------------+ + ;; | | + ;; v | + ;; x: ['a | -]-> ['b | -]--+ | + ;; | | + ;; +----------------+ | + ;; | | + ;; V | + ;; y: ['c | -]-> ['d | '()] | + ;; ^ | + ;; | | + ;; +----------------+ | + ;; | | + ;; z: ['a | -]-> ['b | -]--+ | + ;; w: ------------------------+ + + (test-equal + '(a b c d) + w) + (test-equal + '(b c d) + (cdr x)) + (test-end "3.12"))) diff --git a/sicp/tests/chapter-3/exercise-13.scm b/sicp/tests/chapter-3/exercise-13.scm @@ -0,0 +1,12 @@ +(define-library (sicp tests chapter-3 exercise-13) + (import (scheme base) + (only (srfi :1) last-pair) + (srfi :64) + (only (sicp solutions chapter-3 exercise-13) make-cycle)) + + (begin + (define z (make-cycle (list 'a 'b 'c))) + + (test-begin "3.13") + (test-error (last-pair z)) ; Guile's last-pair checks for and raises an error on cyclic lists. + (test-end "3.13"))) diff --git a/sicp/tests/chapter-3/exercise-14.scm b/sicp/tests/chapter-3/exercise-14.scm @@ -0,0 +1,212 @@ +(define-library (sicp tests chapter-3 exercise-14) + (import (scheme base)) + (import (srfi :64)) + + (begin + (test-begin "3.14") + + (define v '(a b c d)) + + ;; v: [a|-]-> [b|-]-> [c|-]-> [d|()] + + ;; iteration 1 + (define y '()) (define x v) + ;; v: [a|-]-> [b|-]-> [c|-]-> [d|()] + ;; ^ + ;; | + ;; x: --+ + ;; y: () + (test-equal '(a b c d) x) + (test-equal '() y) + + (define temp (cdr x)) + ;; v: [a|-]-> [b|-]-> [c|-]-> [d|()] + ;; ^ ^ + ;; | | + ;; x: --+ | + ;; y: () | + ;; temp: -------+ + (test-equal '(b c d) temp) + + (set-cdr! x y) + ;; v: [a|()] [b|-]-> [c|-]-> [d|()] + ;; ^ ^ + ;; | | + ;; x: --+ | + ;; y: () | + ;; temp: -------+ + (test-equal '(a) x) + + ;; iteration 2 + (define y x) (define x temp) + ;; v: [a|()] [b|-]-> [c|-]-> [d|()] + ;; ^ ^ + ;; | | + ;; +-+ | + ;; | | + ;; +------+ + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: ------+ + (test-equal '(b c d) x) + (test-equal '(a) y) + + (define temp (cdr x)) + ;; v: [a|()] [b|-]-> [c|-]-> [d|()] + ;; ^ ^ ^ + ;; | | | + ;; +-+ | | + ;; | | | + ;; +------+ | + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: --------------+ + (test-equal '(c d) temp) + + (set-cdr! x y) + ;; +----------+ + ;; | | + ;; V | + ;; v: [a|()] [b|-]-+ [c|-]-> [d|()] + ;; ^ ^ ^ + ;; | | | + ;; +-+ | | + ;; | | | + ;; +------+ | + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: --------------+ + (test-equal '(b a) x) + + ;; iteration 3 + (define y x) (define x temp) + ;; +----------+ + ;; | | + ;; V | + ;; v: [a|()] [b|-]-+ [c|-]-> [d|()] + ;; ^ ^ + ;; | | + ;; +--------------+ + ;; | | | + ;; | +----+ | + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: --------------+ + (test-equal '(c d) x) + (test-equal '(b a) y) + + (define temp (cdr x)) + ;; +----------+ + ;; | | + ;; V | + ;; v: [a|()] [b|-]-+ [c|-]-> [d|()] + ;; ^ ^ ^ + ;; | | | + ;; +--------------+ | + ;; | | | + ;; | +----+ | + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: ----------------------+ + (test-equal '(d) temp) + + (set-cdr! x y) + ;; +-----------+ + ;; | | + ;; +----------+ | + ;; | | | | + ;; V V | | + ;; v: [a|()] [b|-]-+ [c|-]-+ [d|()] + ;; ^ ^ ^ + ;; | | | + ;; +--------------+ | + ;; | | | + ;; | +----+ | + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: ----------------------+ + (test-equal '(c b a) x) + + ;; iteration 4 + (define y x) (define x temp) + ;; +-----------+ + ;; | | + ;; +----------+ | + ;; | | | | + ;; V V | | + ;; v: [a|()] [b|-]-+ [c|-]-+ [d|()] + ;; ^ ^ + ;; | | + ;; +------------+ | + ;; | | + ;; +----------------------+ + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: ----------------------+ + (test-equal '(d) x) + (test-equal '(c b a) y) + + (define temp (cdr x)) + ;; +-----------+ + ;; | | + ;; +----------+ | + ;; | | | | + ;; V V | | + ;; v: [a|()] [b|-]-+ [c|-]-+ [d|()] + ;; ^ ^ ^ + ;; | | | + ;; +------------+ | | + ;; | | | + ;; +----------------------+ | + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: ------------------------+ + (test-equal '() temp) + + (set-cdr! x y) + ;; +-----------+ + ;; | | + ;; +----------+ +-----------+ + ;; | | | | | | + ;; V V | V | | + ;; v: [a|()] [b|-]-+ [c|-]-+ [d|-]-+ + ;; ^ ^ + ;; | | () + ;; +------------+ | ^ + ;; | | | + ;; +----------------------+ | + ;; | | | + ;; x: --+ | | + ;; y: ----+ | + ;; temp: ------------------------+ + (test-equal '(d c b a) x) + + ;; iteration 5 + (define y x) (define x temp) + ;; +-----------+ + ;; | | + ;; +----------+ +-----------+ + ;; | | | | | | + ;; V V | V | | + ;; v: [a|()] [b|-]-+ [c|-]-+ [d|-]-+ + ;; ^ + ;; | () + ;; | ^ + ;; | | + ;; +--------------------+ | + ;; | | + ;; x: ----|----------------------+ + ;; y: ----+ | + ;; temp: ------------------------+ + (test-equal '() x) + (test-equal '(d c b a) y) + (test-equal '(a) v) + (test-end "3.14"))) diff --git a/sicp/tests/chapter-3/exercise-15.scm b/sicp/tests/chapter-3/exercise-15.scm @@ -0,0 +1,78 @@ +(define-library (sicp tests chapter-3 exercise-15) + (import (scheme base)) + (import (srfi :64)) + + (begin + (test-begin "3.15") + + (define (set-to-wow! x) + (set-car! (car x) 'wow) + x) + + (define x (list 'a 'b)) + (define z1 (cons x x)) + (define z2 (cons (list 'a 'b) + (list 'a 'b))) + ;; +---+---+ + ;; z1: --> | * | * | + ;; +-|-+-|-+ + ;; V V + ;; +---+---+ +---+---+ + ;; x: --> | * | *-+---->| * | / | + ;; +-|-+---+ +-|-+---+ + ;; V V + ;; +---+ +---+ + ;; | a | | b | + ;; +---+ +---+ + ;; + ;; +---+---+ +---+---+ +---+---+ + ;; z2: --> | * | * +---->| * | *-+--->| * | / | + ;; +-|-+---+ +-|-+---+ +-|-+---+ + ;; | V V + ;; | +---+ +---+ + ;; | | a | | b | + ;; | +---+ +---+ + ;; | ^ ^ + ;; | | | + ;; | +-|-+---+ +-|-+---+ + ;; +---------->| * | *-+--->| * | / | + ;; +---+---+ +---+---+ + (test-equal '(a b) x) + (test-equal '((a b) a b) z1) + (test-equal '((a b) a b) z2) + + (set-to-wow! z1) + (set-to-wow! z2) + ;; +---+---+ + ;; z1: --> | * | * | + ;; +-|-+-|-+ + ;; V V + ;; +---+---+ +---+---+ + ;; x: --> | * | *-+---->| * | / | + ;; +-|-+---+ +-|-+---+ + ;; V V + ;; +-----+ +---+ + ;; | wow | | b | + ;; +-----+ +---+ + ;; + ;; +---+---+ +---+---+ +---+---+ + ;; z2: --> | * | * +---->| * | *-+--->| * | / | + ;; +-|-+---+ +-|-+---+ +-|-+---+ + ;; | V V + ;; | +---+ +---+ + ;; | | a | | b | + ;; | +---+ +---+ + ;; | ^ + ;; | +-----+ | + ;; | | wow | | + ;; | +-----+ | + ;; | ^ | + ;; | | | + ;; | +-|-+---+ +-|-+---+ + ;; +---------->| * | *-+--->| * | / | + ;; +---+---+ +---+---+ + (test-equal '(wow b) x) + (test-equal '((wow b) wow b) z1) + (test-equal '((wow b) a b) z2) + + (test-end "3.15"))) diff --git a/sicp/tests/chapter-3/exercise-16.scm b/sicp/tests/chapter-3/exercise-16.scm @@ -0,0 +1,83 @@ +(define-library (sicp tests chapter-3 exercise-16) + (import (scheme base)) + (import (srfi :64)) + + (begin + (test-begin "3.16") + + (define (count-pairs x) + (if (not (pair? x)) + 0 + (+ (count-pairs (car x)) + (count-pairs (cdr x)) + 1))) + + (define three-pairs '(1 2 3)) + + (define four-pairs + (let ([a (list 1 2)] + [b (list 3)]) + (set-car! (cdr a) b) + (set-cdr! (cdr a) b) + a)) + + (define seven-pairs + (let ([a (list 1)] + [b (list 2)] + [c (list 3)]) + (set-car! a b) + (set-cdr! a b) + (set-car! b c) + (set-cdr! b c) + a)) + + ;; +---+---+ +---+---+ +---+---+ + ;; three-pairs: | 1 | *-+-->| 2 | *-+-->| 3 | * | + ;; +---+---+ +---+---+ +---+---+ + + ;; +---+---+ +---+---+ +---+---+ + ;; four-pairs: | 1 | *-+-->| * | *-+-->| 3 | * | + ;; +---+---+ +-+-+---+ +---+---+ + ;; | ^ + ;; | | + ;; +-------------+ + + ;; +---+---+ +---+---+ +---+---+ + ;; seven-pairs: | * | *-+-->| * | *-+-->| 3 | * | + ;; +-+-+---+ +-+-+---+ +---+---+ + ;; | | ^ ^ + ;; | | | | + ;; +-----------|-+ | + ;; | | + ;; +-------------+ + + (test-equal + '(1 2 3) + three-pairs) + + (test-equal + (cons 1 + (cons (cons 3 '()) + (cons 3 '()))) + four-pairs) + + (test-equal + (cons (cons (cons 3 '()) + (cons 3 '())) + (cons (cons 3 '()) + (cons 3 '()))) + seven-pairs) + + (test-equal + 3 + (count-pairs three-pairs)) + + (test-equal + 4 + (count-pairs four-pairs)) + + (test-equal + 7 + (count-pairs seven-pairs)) + + (test-end "3.16"))) diff --git a/sicp/tests/chapter-3/exercise-17.scm b/sicp/tests/chapter-3/exercise-17.scm @@ -0,0 +1,40 @@ +(define-library (sicp tests chapter-3 exercise-17) + (import (scheme base)) + (import (srfi :64)) + (import (only (sicp solutions chapter-3 exercise-17) count-pairs)) + + (begin + (test-begin "3.17") + + (define three-pairs '(1 2 3)) + + (test-equal + 3 + (count-pairs three-pairs)) + + (define four-pairs + (let ([a (list 1 2)] + [b (list 3)]) + (set-car! (cdr a) b) + (set-cdr! (cdr a) b) + a)) + + (test-equal + 3 + (count-pairs four-pairs)) + + (define seven-pairs + (let ([a (list 1)] + [b (list 2)] + [c (list 3)]) + (set-car! a b) + (set-cdr! a b) + (set-car! b c) + (set-cdr! b c) + a)) + + (test-equal + 3 + (count-pairs seven-pairs)) + + (test-end "3.17"))) diff --git a/sicp/tests/chapter-3/exercise-18.scm b/sicp/tests/chapter-3/exercise-18.scm @@ -0,0 +1,25 @@ +(define-library (sicp tests chapter-3 exercise-18) + (import (scheme base)) + (import (srfi :1)) + (import (srfi :64)) + (import (only (sicp solutions chapter-3 exercise-18) cyclic?)) + + (begin + (test-begin "3.18") + + (define a (list 1 2 3)) + + (define b + (let ([a (list 1 2 3)]) + (set-cdr! (last-pair a) a) + a)) + + (test-equal + #f + (cyclic? a)) + + (test-equal + #t + (cyclic? b)) + + (test-end "3.18"))) diff --git a/sicp/tests/chapter-3/exercise-19.scm b/sicp/tests/chapter-3/exercise-19.scm @@ -0,0 +1,50 @@ +(define-library (sicp tests chapter-3 exercise-19) + (import (scheme base)) + (import (srfi :1)) + (import (srfi :64)) + (import (only (sicp solutions chapter-3 exercise-19) cyclic?)) + + (begin + (test-begin "3.19") + + (define (make-cyclic lst) + (set-cdr! (last-pair lst) lst) + lst) + + (test-equal + #f + (cyclic? '())) + + (test-equal + #f + (cyclic? '(1))) + + (test-equal + #f + (cyclic? '(1 2))) + + (test-equal + #f + (cyclic? '(1 2 3))) + + (test-equal + #t + (cyclic? + (make-cyclic (list 1)))) + + (test-equal + #t + (cyclic? + (make-cyclic (list 1 2)))) + + (test-equal + #t + (cyclic? + (make-cyclic (list 1 2 3)))) + + (test-equal + #t + (cyclic? + (make-cyclic (list 1 2 3 4)))) + + (test-end "3.19"))) diff --git a/sicp/tests/chapter-3/exercise-2.scm b/sicp/tests/chapter-3/exercise-2.scm @@ -0,0 +1,32 @@ +(define-library (sicp tests chapter-3 exercise-2) + (import (scheme base) + (srfi :64) + (sicp solutions 3_2)) + + (begin + (define s (make-monitored sqrt)) + + (test-begin "3.2") + (test-equal + 0 + (s 'how-many-calls?)) + (test-equal + 10 + (s 100)) + (test-equal + 1 + (s 'how-many-calls?)) + (s 100) + (s 100) + (test-equal + 3 + (s 'how-many-calls?)) + (s 'reset-count) + (s 100) + (s 100) + (s 100) + (s 100) + (test-equal + 4 + (s 'how-many-calls?)) + (test-end "3.2"))) diff --git a/sicp/tests/chapter-3/exercise-21.scm b/sicp/tests/chapter-3/exercise-21.scm @@ -0,0 +1,74 @@ +(define-library (sicp tests chapter-3 exercise-21) + (import (scheme base)) + (import (scheme write)) + (import (srfi :64)) + (import (sicp solutions chapter-3 exercise-21)) + + (begin + (test-begin "3.21") + + (define (test-equal-print-queue string-ratsui queue-matsui) + (define string-port (open-output-string)) + + (print-queue queue-matsui string-port) + + (define string-matsui + (get-output-string string-port)) + + (test-equal string-ratsui string-matsui)) + + (define q1 (make-queue)) + (test-equal '(()) q1) + (test-equal-print-queue "()" q1) + + (insert-queue! q1 'a) + (test-equal '((a) a) q1) + (test-equal-print-queue "(a)" q1) + + (insert-queue! q1 'b) + (test-equal '((a b) b) q1) + (test-equal-print-queue "(a b)" q1) + + (insert-queue! q1 'c) + (test-equal '((a b c) c) q1) + (test-equal-print-queue "(a b c)" q1) + + (insert-queue! q1 'd) + (test-equal '((a b c d) d) q1) + (test-equal-print-queue "(a b c d)" q1) + + (delete-queue! q1) + (test-equal '((b c d) d) q1) + (test-equal-print-queue "(b c d)" q1) + + (delete-queue! q1) + (test-equal '((c d) d) q1) + (test-equal-print-queue "(c d)" q1) + + (delete-queue! q1) + (test-equal '((d) d) q1) + (test-equal-print-queue "(d)" q1) + + (delete-queue! q1) + (test-equal '(() d) q1) + (test-equal-print-queue "()" q1) + + ;; When one display the queue, without a special procedure, one + ;; sees the a tree where the first element is the list of items + ;; sorted from first item insert to last item insert to the queue, + ;; and the second item is the last item inserted to the queue, + ;; whether if the queue is empty or not. + ;; ((first-item-inserted second-item-inserted ...) last-item-inserted) + ;; or + ;; (() last-item-inserted) + + ;; One can see the last item inserted to the queue right after the + ;; only item in it is deleted because the rear pointer of the + ;; queue does not change which object it points at when + ;; delete-queue! is used when there is only one item in the + ;; queue. It does not need to change because when the queue is + ;; empty and then a new item is inserted, a new (cons item '()) is + ;; created, and both the front and rear pointers are pointed at + ;; it. + + (test-end "3.21"))) diff --git a/sicp/tests/chapter-3/exercise-22.scm b/sicp/tests/chapter-3/exercise-22.scm @@ -0,0 +1,47 @@ +(define-library (sicp tests chapter-3 exercise-22) + (import (scheme base)) + (import (scheme write)) + (import (srfi :64)) + (import (sicp solutions chapter-3 exercise-22)) + + (begin + (test-begin "3.22") + + (define (test-equal-print-queue string-ratsui queue-matsui) + (define string-port (open-output-string)) + + ((queue-matsui 'print-queue) string-port) + + (define string-matsui + (get-output-string string-port)) + + (test-equal string-ratsui string-matsui)) + + (define q1 (make-queue)) + (test-equal-print-queue "()" q1) + + ((q1 'insert-queue!) 'a) + (test-equal-print-queue "(a)" q1) + + ((q1 'insert-queue!) 'b) + (test-equal-print-queue "(a b)" q1) + + ((q1 'insert-queue!) 'c) + (test-equal-print-queue "(a b c)" q1) + + ((q1 'insert-queue!) 'd) + (test-equal-print-queue "(a b c d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "(b c d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "(c d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "(d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "()" q1) + + (test-end "3.22"))) diff --git a/sicp/tests/chapter-3/exercise-23.scm b/sicp/tests/chapter-3/exercise-23.scm @@ -0,0 +1,173 @@ +(define-library (sicp tests chapter-3 exercise-23) + (import (scheme base)) + (import (scheme write)) + + (import (srfi :64)) + + (import (sicp solutions chapter-3 exercise-23)) + + (begin + (test-begin "3.23") + + (define (test-equal-print-deque string-ratsui deque-matsui) + (define string-port (open-output-string)) + + (print-deque deque-matsui string-port) + + (print-deque deque-matsui) (newline) + + (define string-matsui + (get-output-string string-port)) + + (test-equal string-ratsui string-matsui)) + + (define q1 (make-deque)) + (test-equal-print-deque "()" q1) + (test-error (front-deque q1)) + (test-error (rear-deque q1)) + + (rear-insert-deque! q1 1) + (test-equal-print-deque "(1)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (rear-insert-deque! q1 2) + (test-equal-print-deque "(1 2)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 2 + (rear-deque q1)) + + (rear-insert-deque! q1 3) + (test-equal-print-deque "(1 2 3)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 3 + (rear-deque q1)) + + (rear-insert-deque! q1 4) + (test-equal-print-deque "(1 2 3 4)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + (front-delete-deque! q1) + (test-equal-print-deque "(2 3 4)" q1) + (test-equal + 2 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + (front-delete-deque! q1) + (test-equal-print-deque "(3 4)" q1) + (test-equal + 3 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + (front-delete-deque! q1) + (test-equal-print-deque "(4)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + + (front-delete-deque! q1) + (test-equal-print-deque "()" q1) + (test-error + (front-deque q1)) + (test-error + (rear-deque q1)) + + (front-insert-deque! q1 1) + (test-equal-print-deque "(1)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (front-insert-deque! q1 2) + (test-equal-print-deque "(2 1)" q1) + (test-equal + 2 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (front-insert-deque! q1 3) + (test-equal-print-deque "(3 2 1)" q1) + (test-equal + 3 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (front-insert-deque! q1 4) + (test-equal-print-deque "(4 3 2 1)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "(4 3 2)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 2 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "(4 3)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 3 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "(4)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "()" q1) + (test-error (front-deque q1)) + (test-error (rear-deque q1)) + + + (test-end "3.23"))) diff --git a/sicp/tests/chapter-3/exercise-25.scm b/sicp/tests/chapter-3/exercise-25.scm @@ -0,0 +1,26 @@ +(define-library (sicp tests chapter-3 exercise-25) + (import (scheme base)) + (import (scheme write)) + + (import (srfi :64)) + + (import (sicp solutions chapter-3 exercise-25)) + + (begin + (test-begin "3.25") + + (define t (make-table)) + + (display t) (newline) + (display (t 'lookup)) (newline) + (display (t 'insert!)) (newline) + + (display (t 'local-table)) (newline) + + (display ((t 'insert!) '(a) 1)) (newline) + (display (t 'local-table)) (newline) + (display ((t 'lookup) '(a))) (newline) + + + + (test-end "3.25"))) diff --git a/sicp/tests/chapter-3/exercise-3.scm b/sicp/tests/chapter-3/exercise-3.scm @@ -0,0 +1,17 @@ +(define-library (sicp tests chapter-3 exercise-3) + (import (scheme base) + (srfi :64) + (sicp solutions 3_3)) + + (begin + (define acc + (make-account 100 'secret-password)) + + (test-begin "3.3") + (test-equal + 60 + ((acc 'secret-password 'withdraw) 40)) + (test-equal + "Incorrect password" + ((acc 'some-other-password 'deposit) 50)) + (test-end "3.3"))) diff --git a/sicp/tests/chapter-3/exercise-4.scm b/sicp/tests/chapter-3/exercise-4.scm @@ -0,0 +1,38 @@ +(import (srfi :64)) +(import (sicp solutions chapter-3 exercise-4)) + +(define acc + (make-account 100 'secret-password)) + +(test-begin "3.4") +(test-equal + 60 + ((acc 'secret-password 'withdraw) 40)) +(test-equal + "Incorrect password" + ((acc 'some-other-password 'deposit) 50)) +(test-equal + "Incorrect password" + ((acc 'some-other-password 'deposit) 50)) +(test-equal + "Incorrect password" + ((acc 'some-other-password 'deposit) 50)) +(test-equal + "Incorrect password" + ((acc 'some-other-password 'deposit) 50)) +(test-equal + "Incorrect password" + ((acc 'some-other-password 'deposit) 50)) +(test-equal + "Incorrect password" + ((acc 'some-other-password 'deposit) 50)) +(test-equal +"Cops called." + ((acc 'some-other-password 'deposit) 50)) +(test-equal +"Cops called." + ((acc 'some-other-password 'deposit) 50)) +(test-equal +"Cops called." + ((acc 'some-other-password 'deposit) 50)) +(test-end "3.4") diff --git a/sicp/tests/chapter-3/exercise-6.scm b/sicp/tests/chapter-3/exercise-6.scm @@ -0,0 +1,22 @@ +(import (srfi :64)) +(import (sicp solutions chapter-3 exercise-6)) + +(rand 'reset 0) + +(define random-sequence-a + (map + (lambda (x) (rand 'generate)) + (iota 10))) + +(rand 'reset 0) + +(define random-sequence-b + (map + (lambda (x) (rand 'generate)) + (iota 10))) + +(test-begin "3.6") +(test-equal + random-sequence-a + random-sequence-b) +(test-end "3.6") diff --git a/sicp/tests/chapter-3/exercise-7.scm b/sicp/tests/chapter-3/exercise-7.scm @@ -0,0 +1,27 @@ +(define-library (sicp tests chapter-3 exercise-7) + (import (scheme base)) + (import (scheme write)) + (import (srfi :64)) + (import (only (sicp solutions chapter-3 exercise-3) make-account)) + (import (sicp solutions chapter-3 exercise-7)) + + (begin + (define acc + (make-account 100 + 'secret-password)) + + (define joint-acc (make-joint acc + 'secret-password + 'another-secret-password)) + + (test-begin "3.7") + (test-equal + 60 + ((acc 'secret-password 'withdraw) 40)) + (test-equal + "Incorrect password" + ((acc 'incorrect-password 'deposit) 50)) + (test-equal + 110 + ((joint-acc 'another-secret-password 'deposit) 50)) + (test-end "3.7"))) diff --git a/sicp/tests/chapter-3/exercise-8.scm b/sicp/tests/chapter-3/exercise-8.scm @@ -0,0 +1,16 @@ +(define-library (sicp tests chapter-3 exercise-8) + (import (scheme base)) + (import (srfi srfi-64)) + (import (only (sicp solutions chapter-3 exercise-8) make-f)) + + (begin + (define f (make-f)) + + (test-begin "3.8") + (test-equal + 1 ; Turns out it starts with the right one. + ;; People of #scheme @ libera.chat say it is an implementation detail. + ;; The specification leaves the order of evaluation unspecified, + ;; and therefore one should avoid writing code that depends on it. + (+ (f 0) (f 1))) + (test-end "3.8")))