commit 19ddba23d9a6d88aea943c781ec5f0f71ca8944f
parent 2250859ae9c1ad24755ab203e8ed62a5ec7a855d
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Fri, 10 Mar 2023 09:42:17 +0200
Add a bunch of stuff up to 2.24. I skipped a few. Should return to them later.
Diffstat:
| M | guile.scm | | | 1684 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- |
1 file changed, 1670 insertions(+), 14 deletions(-)
diff --git a/guile.scm b/guile.scm
@@ -2,7 +2,27 @@
--no-auto-compile
!#
-(use-modules (srfi srfi-64))
+(use-modules (srfi srfi-1)
+ (srfi srfi-19)
+ (srfi srfi-26) ; cut <> <...> and cute (which is evaluated non-slots (non-<>)).
+ (srfi srfi-42) ; list comprehensions with list-ec.
+ (srfi srfi-64) ; test-begin, test-equal, and test-end.
+ (statprof)
+ (ice-9 time)
+ (ice-9 textual-ports)
+ )
+
+(use-modules (ice-9 format))
+
+(define (dp . args)
+ (cond
+ ((null? args) '())
+ ((null? (cdr args))
+ (display (car args))
+ (newline))
+ (else (display (car args))
+ (display " ")
+ (apply dp (cdr args)))))
#!
@@ -68,8 +88,8 @@
6
(* (cond ((> a b) a)
- ((< a b) b)
- (else -1))
+ ((< a b) b)
+ (else -1))
(+ a 1))
@@ -100,14 +120,14 @@
(test-begin "1.2")
(test-equal
(/ (+ 5
- 4
- (- 2
- (- 3
- (+ 6
- (/ 4 5)))))
+ 4
+ (- 2
+ (- 3
+ (+ 6
+ (/ 4 5)))))
(* 3
- (- 6 2)
- (- 2 7)))
+ (- 6 2)
+ (- 2 7)))
(/ (- 37) 150))
(test-end "1.2")
@@ -122,11 +142,11 @@
(define (exercise-1-3 a b c)
(if (< a b)
(if (< c a)
- (sum-of-squares a b)
- (sum-of-squares c b))
+ (sum-of-squares a b)
+ (sum-of-squares c b))
(if (< c b)
- (sum-of-squares b a)
- (sum-of-squares c a))))
+ (sum-of-squares b a)
+ (sum-of-squares c a))))
(test-begin "1.3")
(test-equal (exercise-1-3 2 3 5) 34)
@@ -228,5 +248,1641 @@ Normal-order evaluation:
What happens when Alyssa attempts to use this to compute square
roots? Explain.
+(sqrt-iter 1 2)
+(new-if (good-enough? 1 2)
+ guess
+ (sqrt-iter (improve 1 2)
+ 2))
+(new-if #f
+ guess
+ (new-if (good-enough? (improve 1 2) 2)
+ (improve 1 2)
+ (sqrt-iter (improve (improve 1 2) 2)
+ 2)))
+and so on.
+
+new-if would first have to evaluate all of its arguments, and only then would it choose the right value using cond.
!#
+
+#!
+
+ *Exercise 1.7:* The `good-enough?' test used in computing square
+ roots will not be very effective for finding the square roots of
+ very small numbers. Also, in real computers, arithmetic operations
+ are almost always performed with limited precision. This makes
+ our test inadequate for very large numbers. Explain these
+ statements, with examples showing how the test fails for small and
+ large numbers. An alternative strategy for implementing
+ `good-enough?' is to watch how `guess' changes from one iteration
+ to the next and to stop when the change is a very small fraction
+ of the guess. Design a square-root procedure that uses this kind
+ of end test. Does this work better for small and large numbers?
+
+!#
+
+
+(define (square-root x)
+ (define (average a b)
+ (/ (+ a b) 2))
+
+ (define (improve guess x)
+ ;; (dp guess x)
+ (average guess (/ x guess)))
+
+ (define (good-enough? old-guess new-guess)
+ (define bound 0.0000000000001)
+ (define ratio (/ old-guess new-guess))
+
+ (define within-bounds
+ (< (- 1 bound) ratio (+ 1 bound)))
+
+ ;; (dp bound ratio within-bounds)
+
+ within-bounds)
+
+ (define (square-root-iter guess x)
+ (define new-guess (improve guess x))
+ ;; (dp new-guess)
+
+ (if (good-enough? guess new-guess)
+ guess
+ (square-root-iter new-guess
+ x)))
+
+ (square-root-iter 1 x))
+
+(format #t "~f\n" (square-root 0.000000000001))
+(format #t "~f\n" (square-root (/ 1 0.000000000001)))
+
+#!
+
+ *Exercise 1.8:* Newton's method for cube roots is based on the
+ fact that if y is an approximation to the cube root of x, then a
+ better approximation is given by the value
+
+ x/y^2 + 2y
+ ----------
+ 3
+
+ Use this formula to implement a cube-root procedure analogous to
+ the square-root procedure. (In section *Note 1-3-4:: we will see
+ how to implement Newton's method in general as an abstraction of
+ these square-root and cube-root procedures.)
+
+!#
+
+(define (cube-root x)
+ (define (improve guess)
+ ;; (dp guess x)
+
+ (/ (+ (/ x
+ (* guess guess))
+ (* 2 guess))
+ 3))
+
+ (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 (cube-root-iter guess)
+ (define new-guess (improve guess))
+ ;; (dp new-guess)
+
+ (if (good-enough? guess new-guess)
+ guess
+ (cube-root-iter new-guess)))
+
+ (cube-root-iter 1))
+
+(format #t "(cube-root ~f) => ~f\n" 0.000000000001 (cube-root 0.000000000001))
+(format #t "(cube-root ~f) => ~f\n" (/ 1 0.000000000001) (cube-root (/ 1 0.000000000001)))
+
+#!
+
+ *Exercise 1.9:* Each of the following two procedures defines a
+ method for adding two positive integers in terms of the procedures
+ `inc', which increments its argument by 1, and `dec', which
+ decrements its argument by 1.
+
+ (define (+ a b)
+ (if (= a 0)
+ b
+ (inc (+ (dec a) b))))
+
+ (define (+ a b)
+ (if (= a 0)
+ b
+ (+ (dec a) (inc b))))
+
+ Using the substitution model, illustrate the process generated by
+ each procedure in evaluating `(+ 4 5)'. Are these processes
+ iterative or recursive?
+
+First:
+
+(+ 4 5)
+(if (= 4 0)
+ 5
+ (inc (+ (dec 4) 5)))
+(if #f
+ 5
+ (inc (+ (dec 4) 5)))
+(inc (+ (dec 4) 5))
+(inc (+ 3 5))
+(inc (if (= 3 0)
+ 5
+ (inc (+ (dec 3) 5))))
+(inc (if #f
+ 5
+ (inc (+ (dec 3) 5))))
+(inc
+ (inc (+ (dec 3) 5)))
+(inc
+ (inc (+ 2 5)))
+(inc
+ (inc (if (= 2 0)
+ 5
+ (inc (+ (dec 2) 5)))))
+(inc
+ (inc (if #f
+ 5
+ (inc (+ (dec 2) 5)))))
+(inc
+ (inc
+ (inc (+ (dec 2) 5))))
+(inc
+ (inc
+ (inc (+ 1 5))))
+(inc
+ (inc
+ (inc (if (= 1 0)
+ 5
+ (inc (+ (dec 1) 5))))))
+(inc
+ (inc
+ (inc (if #f
+ 5
+ (inc (+ (dec 1) 5))))))
+(inc (inc (inc (inc (+ (dec 1) 5)))))
+(inc (inc (inc (inc (+ 0 5)))))
+(inc (inc (inc (inc (if (= 0 0) 5 (inc (+ (dec 0) 5)))))))
+(inc (inc (inc (inc (if #t 5 (inc (+ (dec 0) 5)))))))
+(inc (inc (inc (inc 5))))
+(inc (inc (inc 6)))
+(inc (inc 7))
+(inc 8)
+9
+
+Recursive.
+
+Second:
+
+(+ 4 5)
+(if (= 4 0) 5 (+ (dec 4) (inc 5)))
+(if #f 5 (+ (dec 4) (inc 5)))
+(+ 3 6)
+(if (= 3 0) 6 (+ (dec 3) (inc 6)))
+(if #f 6 (+ (dec 3) (inc 6)))
+(+ (dec 3) (inc 6))
+(+ 2 7)
+(if (= 2 0) 7 (+ (dec 2) (inc 7)))
+(if #f 7 (+ (dec 2) (inc 7)))
+(+ (dec 2) (inc 7))
+(+ 1 8)
+(if (= 1 0) 8 (+ (dec 1) (inc 8)))
+(if #f 8 (+ (dec 1) (inc 8)))
+(+ (dec 1) (inc 8))
+(+ 0 9)
+(if (= 0 0) 9 (+ (dec 0) (inc 9)))
+(if #f 9 (+ (dec 0) (inc 9)))
+9
+
+Iterative.
+
+!#
+
+#!
+
+ *Exercise 1.10:* The following procedure computes a mathematical
+ function called Ackermann's function.
+
+ (define (A x y)
+ (cond ((= y 0) 0)
+ ((= x 0) (* 2 y))
+ ((= y 1) 2)
+ (else (A (- x 1)
+ (A x (- y 1))))))
+
+ What are the values of the following expressions?
+
+ (A 1 10)
+
+ (A 2 4)
+
+ (A 3 3)
+
+ Consider the following procedures, where `A' is the procedure
+ defined above:
+
+ (define (f n) (A 0 n))
+
+ (define (g n) (A 1 n))
+
+ (define (h n) (A 2 n))
+
+ (define (k n) (* 5 n n))
+
+ Give concise mathematical definitions for the functions computed
+ by the procedures `f', `g', and `h' for positive integer values of
+ n. For example, `(k n)' computes 5n^2.
+
+
+ (define (A x y)
+ (cond ((= y 0) 0)
+ ((= x 0) (* 2 y))
+ ((= y 1) 2)
+ (else (A (- x 1)
+ (A x (- y 1))))))
+
+(A 1 10)
+(cond ((= 10 0) 0)
+ ((= 1 0) (* 2 10))
+ ((= 10 1) 2)
+ (else (A (- 1 1)
+ (A 1 (- 10 1)))))
+(A (- 1 1)
+ (A 1 (- 10 1)))
+(A 0 (A 1 9))
+(A 0 (A 0 (A 1 8)))
+(A 0 (A 0 (A 0 (A 1 7))))
+(A 0 (A 0 (A 0 (A 0 (A 1 6)))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 1 5))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 4)))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 3))))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 2)))))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 1))))))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 2)))))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (* 2 2)))))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 8)))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 (A 0 16))))))
+(A 0 (A 0 (A 0 (A 0 (A 0 32)))))
+(A 0 (A 0 (A 0 (A 0 64))))
+(A 0 (A 0 (A 0 128)))
+(A 0 (A 0 256))
+(A 0 512)
+1024
+
+ (define (A x y)
+ (cond ((= y 0) 0)
+ ((= x 0) (* 2 y))
+ ((= y 1) 2)
+ (else (A (- x 1)
+ (A x (- y 1))))))
+
+
+(A 2 4)
+(cond ((= 4 0) 0)
+ ((= 2 0) (* 2 4))
+ ((= 4 1) 2)
+ (else (A (- 2 1)
+ (A 2 (- 4 1)))))
+(A 1
+ (A 1 (A 2 (- 3 1))))
+
+(A 1
+ (A 1 (A 2 (- 3 1))))
+(A 1
+ (A 1 (A 2 (- 3 1))))
+
+
+!#
+
+(define (A x y)
+ (cond ((= y 0) 0)
+ ((= x 0) (* 2 y))
+ ((= y 1) 2)
+ (else (A (- x 1)
+ (A x (- y 1))))))
+
+(test-begin "1.10")
+'(test-equal 1024 (A 1 10))
+'(test-equal 1024 (A 2 4))
+(test-end "1.10")
+
+#!
+
+ *Exercise 1.11:* A function f is defined by the rule that f(n) = n
+ if n<3 and f(n) = f(n - 1) + 2f(n - 2) + 3f(n - 3) if n>= 3.
+ Write a procedure that computes f by means of a recursive process.
+ Write a procedure that computes f by means of an iterative
+ process.
+
+!#
+
+(define (f-recursive n)
+ (cond
+ ((< n 3) n)
+ (else (+ (f-recursive (1- n))
+ (* 2 (f-recursive (- n 2)))
+ (* 3 (f-recursive (- n 3)))))))
+
+(define (f-iterative n)
+ (define (f i n a b c)
+ (cond
+ ((= i n) a)
+ (else (f (1+ i)
+ n
+ b
+ c
+ (+ c
+ (* 2 b)
+ (* 3 a))))))
+ (f 0 n 0 1 2))
+
+(test-begin "1.11")
+(test-equal
+ (map f-recursive '(0 1 2 3 4 5 6 7))
+ (map f-iterative '(0 1 2 3 4 5 6 7)))
+(test-end "1.11")
+
+#!
+
+ *Exercise 1.12:* The following pattern of numbers is called "Pascal's
+ triangle".
+
+ 1
+ 1 1
+ 1 2 1
+ 1 3 3 1
+ 1 4 6 4 1
+
+ The numbers at the edge of the triangle are all 1, and each number
+ inside the triangle is the sum of the two numbers above it.(4)
+ Write a procedure that computes elements of Pascal's triangle by
+ means of a recursive process.
+
+!#
+
+(define (pascal line column)
+ (cond
+ ((or (= column 0)
+ (= column line)) 1)
+ (else (+ (pascal (1- line)
+ (1- column))
+ (pascal (1- line)
+ column)))))
+
+(test-begin "1.12")
+(test-equal
+ (list (pascal 0 0)
+ (pascal 1 0)
+ (pascal 1 1)
+ (pascal 2 0)
+ (pascal 2 1)
+ (pascal 2 2)
+ (pascal 3 0)
+ (pascal 3 1)
+ (pascal 3 2)
+ (pascal 3 3)
+ (pascal 4 0)
+ (pascal 4 1)
+ (pascal 4 2)
+ (pascal 4 3)
+ (pascal 4 4)
+ )
+ '(1
+ 1
+ 1
+ 1
+ 2
+ 1
+ 1
+ 3
+ 3
+ 1
+ 1
+ 4
+ 6
+ 4
+ 1))
+(test-end "1.12")
+
+#!
+
+ *Exercise 1.13:* Prove that _Fib_(n) is the closest integer to
+ [phi]^n/[sqrt](5), where [phi] = (1 + [sqrt](5))/2. Hint: Let
+ [illegiblesymbol] = (1 - [sqrt](5))/2. Use induction and the
+ definition of the Fibonacci numbers (see section *Note 1-2-2::) to
+ prove that _Fib_(n) = ([phi]^n - [illegiblesymbol]^n)/[sqrt](5).
+
+!#
+
+#! oh boy. !#
+
+#!
+
+1.14
+
+!#
+
+(define (count-change amount)
+ (cc amount 5))
+
+(define (cc amount kinds-of-coins)
+ (cond ((= amount 0) 1)
+ ((or (< amount 0) (= kinds-of-coins 0)) 0)
+ (else (+ (cc amount
+ (- kinds-of-coins 1))
+ (cc (- amount
+ (first-denomination kinds-of-coins))
+ kinds-of-coins)))))
+
+(define (first-denomination kinds-of-coins)
+ (cond ((= kinds-of-coins 1) 1)
+ ((= kinds-of-coins 2) 5)
+ ((= kinds-of-coins 3) 10)
+ ((= kinds-of-coins 4) 25)
+ ((= kinds-of-coins 5) 50)))
+
+#!
+
+1.16
+
+!#
+
+(define (flatten a)
+ (cond
+ ((null? a) '())
+ (else (append (car a) (flatten (cdr a))))))
+
+(test-begin "flatten")
+(test-equal (flatten '((1 2) (3 4) (5 6))) '(1 2 3 4 5 6))
+(test-end "flatten")
+
+(define (cartesian a b)
+ (define (cartesian' a-element b)
+ (cond
+ ((null? b) '())
+ (else (cons (cons a-element (car b))
+ (cartesian' a-element (cdr b))))))
+ (cond
+ ((null? a) '())
+ (else (flatten (map (cut cartesian' <> b) a)))))
+
+(test-begin "cartesian")
+(test-equal
+ (cartesian '(1 2 3)
+ '(4 5 6))
+ '((1 . 4)
+ (1 . 5)
+ (1 . 6)
+ (2 . 4)
+ (2 . 5)
+ (2 . 6)
+ (3 . 4)
+ (3 . 5)
+ (3 . 6)))
+(test-end "cartesian")
+
+(define (fast-expt-recursive b n)
+ (cond ((= n 0) 1)
+ ((even? n) (square (fast-expt-recursive b (/ n 2))))
+ (else (* b (fast-expt-recursive b (- n 1))))))
+
+(define (fast-expt-iterative b n)
+ (define (f a b n)
+ (cond
+ ((= n 0) a)
+ ((even? n) (f a
+ (* b b)
+ (/ n 2)))
+ (else (f (* a b)
+ b
+ (1- n)))))
+ (f 1 b n))
+
+(test-begin "1.16")
+(test-equal (fast-expt-recursive 2 3) (fast-expt-iterative 2 3))
+;; 1 * 2**3 =
+;; 2 * 2**2 = 2 * (2**1)**2
+;; 2 *
+(test-equal (fast-expt-iterative 3 5) (fast-expt-recursive 3 5))
+;; a * b^n =
+;; 1 * 3^5 =
+;; 3 * 3^4 =
+;; 3 * 3 * 3 * 3^2
+;; 3 * 3 * 3 * 3 * 3
+(test-equal (fast-expt-iterative 5 7) (fast-expt-recursive 5 7))
+;; 5**7 =
+;; 5 * (5**3)**2 =
+;; 5 * (5**2)**3
+;; 5 * 5**2 * 5**3 =
+;; 5 * 5**2 * 5 * 5**2 =
+(test-equal (fast-expt-iterative 7 11) (fast-expt-recursive 7 11))
+(test-end "1.16")
+
+;; Exercise 1.17
+
+(define (*-recursive a b)
+ (if (= b 0)
+ 0
+ (+ a (*-recursive a (- b 1)))))
+
+(define (double n)
+ (* 2 n))
+
+(define (halve n)
+ (/ n 2))
+
+(define (fast-*-recursive a b)
+ (cond
+ ((= b 0) 0)
+ ((even? b) (+ (double a)
+ (fast-*-recursive a
+ (- b 2))))
+ (else (+ a (fast-*-recursive a (1- b))))))
+
+(test-begin "1.17")
+(test-equal (*-recursive 2 3) (fast-*-recursive 2 3))
+;; a * b =
+;; 2 * 3 = odd b
+;; 4 * 2 = even b
+;;
+(test-equal (* 3 5) (*-recursive 3 5))
+(test-equal (* 5 7) (*-recursive 5 7))
+(test-equal (* 7 11) (*-recursive 7 11))
+
+(test-equal (* 3 5) (fast-*-recursive 3 5))
+(test-equal (* 5 7) (fast-*-recursive 5 7))
+(test-equal (* 7 11) (fast-*-recursive 7 11))
+(test-end "1.17")
+
+;; Exercise 1.18
+
+(define (fast-*-iterative a b)
+ (define (f result a b)
+ (cond
+ ((= b 0) result)
+ ((even? b) (f result
+ (double a)
+ (halve b)))
+ (else (f (+ result a) a (1- b)))))
+ (f 0 a b))
+
+(test-begin "1.18")
+(test-equal (* 3 5) (fast-*-iterative 3 5))
+;; 0 3 5
+;;
+(test-equal (* 5 7) (fast-*-iterative 5 7))
+(test-equal (* 7 11) (fast-*-iterative 7 11))
+(test-end "1.18")
+
+;; Exercise 1.19
+
+;; T
+;; a <- (a + b)
+;; b <- a
+;;
+;; Tpq =
+;; a <- bq + aq + ap
+;; a <- bq + a(q + p)
+;; b <- bp + aq
+;;
+;; Tpq^2 =
+;; a' <- (bp + aq)q + (bq + aq + ap)q + (bq + aq + ap)p
+;; a' <- bpq + aq^2 + bq^2 + aq^2 + apq + bpq + apq + ap^2
+;; a' <- 2bpq + 2aq^2 + bq^2 + 2apq + ap^2
+;; a' <- b(2pq + q^2) + (2apq + ap^2 + 2aq^2)
+;; a' <- b(2pq + q^2) + a(2pq + p^2 + 2q^2)
+;; q = 2pq + q^2
+;; p + q = 2pq + p^2 + 2q^2
+;; p = (2pq + p^2 + 2q^2) - (2pq + q^2)
+;; p = 2pq + p^2 + 2q^2 - 2pq - q^2
+;; p = p^2 + q^2
+;; a' <- b(2pq + q^2) + a(2pq + q^2) + a(p^2 + q^2)
+;;
+;; oh. i'm dumb. we already have q' and p' in terms of q and p here:
+;;
+;; b' <- (bp + aq)p + (bq + aq + ap)q
+;; b' <- bp^2 + apq + bq^2 + aq^2 + apq
+;; b' <- bp^2 + 2apq + bq^2 + aq^2
+;; b' <- bp^2 + bq^2 + 2apq + aq^2
+;; b' <- b(p^2 + q^2) + a(2pq + q^2)
+
+(define (fib n)
+ (cond
+ ((= n 0) 0)
+ ((= n 1) 1)
+ (else (+ (fib (1- n))
+ (fib (- n 2))))))
+
+(define (fast-fib n)
+ (define (fib-iter a b p q count)
+ (cond
+ ((= count 0) b)
+ ((even? count)
+ (fib-iter a
+ b
+ (+ (* p p)
+ (* q q))
+ (+ (* 2 p q)
+ (* q q))
+ (/ count 2)))
+ (else
+ (fib-iter (+ (* b q)
+ (* a q)
+ (* a p))
+ (+ (* b p)
+ (* a q))
+ p
+ q
+ (1- count)))))
+ (fib-iter 1 0 0 1 n))
+
+(test-begin "1.19")
+(test-equal (fib 0) (fast-fib 0))
+(test-equal (fib 1) (fast-fib 1))
+(test-equal (fib 2) (fast-fib 2))
+(test-equal (fib 3) (fast-fib 3))
+(test-equal (fib 4) (fast-fib 4))
+(test-equal (fib 5) (fast-fib 5))
+(test-end "1.19")
+
+;; Exercise 1.20
+
+
+
+(define (gcd-iterative a b)
+ ;; a = b*d + r
+ (if (= b 0)
+ a
+ (gcd-iterative b (remainder a b))))
+
+;; Normal-order
+
+(test-begin "1.20")
+(test-equal (gcd-iterative 206 40) (gcd 206 40))
+(test-equal (if (= 40 0)
+ 206
+ (gcd 40 (remainder 206 40))) 2)
+(test-equal (if #f
+ 206
+ (gcd 40 (remainder 206 40))) 2)
+(test-equal (gcd 40 (remainder 206 40)) 2)
+(test-equal (if (= (remainder 206 40) 0) ;; 1 remainder
+ 40
+ (gcd (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))) 2)
+(test-equal (if (= 6 0)
+ 40
+ (gcd (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))) 2)
+(test-equal (gcd (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))) 2)
+(test-equal (if (= (remainder 40
+ (remainder 206 40)) 0)
+ (remainder 206 40)
+ (gcd (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))))) 2)
+(test-equal (if (= 4 0) ;; previous 1 and 2 here equals 3
+ (remainder 206 40)
+ (gcd (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))))) 2)
+(test-equal (gcd (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))) 2)
+(test-equal 2 (if (= (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))) 0)
+ (remainder 40
+ (remainder 206 40))
+ (gcd (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))
+ (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))))))
+(test-equal 2 (if (= 2 0) ;; 4 now plus 3 previously is 5
+ (remainder 40
+ (remainder 206 40))
+ (gcd (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))
+ (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))))))
+(test-equal 2 (gcd (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))
+ (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))))))
+(test-equal 2 (if (= (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))) 0)
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))
+ (gcd
+ (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))))
+ (reminder (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))
+ (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))))))))
+(test-equal 2 (if (= 0 0) ;; 5 previously plus 7 = 12
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))
+ (gcd
+ (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))))
+ (reminder (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))
+ (remainder (remainder 40
+ (remainder 206 40))
+ (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40))))))))
+(test-equal 2 (remainder (remainder 206 40)
+ (remainder 40
+ (remainder 206 40)))) ;; 12 previously and 4 now is 16.
+
+;; Now for applicative-order evaluation:
+(test-equal 2 (gcd 206 40))
+(test-equal 2 (if (= 40 0)
+ 206
+ (gcd 40 (remainder 206 40))))
+(test-equal 2 (if #f
+ 206
+ (gcd 40 (remainder 206 40))))
+(test-equal 2 (gcd 40 (remainder 206 40)))
+(test-equal 2 (gcd 40 6)) ;; 1
+(test-equal 2 (if (= 6 0)
+ 40
+ (gcd 6 (remainder 40 6))))
+(test-equal 2 (gcd 6 (remainder 40 6)))
+(test-equal 2 (gcd 6 4)) ;; 2
+(test-equal 2 (if (= 4 0)
+ 6
+ (gcd 4 (remainder 6 4))))
+(test-equal 2 (if #f
+ 6
+ (gcd 4 (remainder 6 4))))
+(test-equal 2 (gcd 4 (remainder 6 4)))
+(test-equal 2 (gcd 4 2)) ;; 3
+(test-equal 2 (if (= 2 0)
+ 4
+ (gcd 2 (remainder 4 2))))
+(test-equal 2 (if #f
+ 4
+ (gcd 2 (remainder 4 2))))
+(test-equal 2 (gcd 2 (remainder 4 2)))
+(test-equal 2 (gcd 2 0)) ;; 4
+(test-equal 2 (if (= 0 0)
+ 2
+ (gcd 0 (remainder 2 0))))
+(test-equal 2 (if #t
+ 2
+ (gcd 0 (remainder 2 0))))
+(test-equal 2 2)
+(test-end "1.20")
+
+;; 1.21
+
+(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)))
+
+(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")
+
+(define (expmod base exp m)
+ (cond
+ ((= exp 0) 1)
+ ((even? exp)
+ (remainder
+ (square (expmod base
+ (/ exp 2)
+ m))
+ m))
+ (else
+ (remainder
+ (* base
+ (expmod base
+ (1- exp)
+ m))
+ m))))
+
+(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")
+
+(define (fermat-test n)
+ (define (try-it a)
+ (= (expmod a n n)
+ a))
+ (try-it (1+ (random (1- n)))))
+
+(define (fast-prime? n times)
+ (cond
+ ((zero? times) #t)
+ ((fermat-test n)
+ (fast-prime? n (1- times)))
+ (else #f)))
+
+(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")
+
+;; Exercise 1.21
+
+(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")
+
+;; Exercise 1.22
+
+(define (run-delay-if-full-flag d)
+ (if (any (cut equal? "--full" <>)
+ (command-line))
+ (force d)))
+
+(run-delay-if-full-flag
+ (delay
+ (let ((port (open-output-file "primes.txt")))
+
+ (define (runtime)
+ (time-nanosecond (current-time time-process)))
+
+ (define (display x)
+ (format port "~a" x))
+
+ (define (newline)
+ (format port "\n"))
+
+ (define (timed-prime-test n)
+ ;; (newline)
+ ;; (display n)
+ (start-timed-test n (runtime)))
+
+ (define (start-timed-test n start-time)
+ (cond
+ ((prime? n)
+ (newline)
+ (display "[")
+ (display n)
+ (report-prime (- (runtime)
+ start-time)))
+ (else #f)))
+
+ (define (report-prime elapsed-time)
+ (display ", ")
+ (display elapsed-time)
+ (display "],")
+ (newline)
+ #t)
+
+ (define (search-for-primes start-number end-number)
+ (cond
+ ((> start-number end-number) '())
+ ((timed-prime-test start-number)
+ (cons start-number
+ (search-for-primes (+ start-number 2) end-number)))
+ (else (search-for-primes (+ start-number 2) end-number))))
+
+ (display "[")
+
+ (search-for-primes 3 100001)
+
+ (display "]")
+ (newline))))
+
+;; Exercise 1.23
+
+(define (next test-divisor)
+ (if (= test-divisor 2)
+ 3
+ (+ test-divisor 2)))
+
+(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 (next test-divisor)))))
+
+(test-begin "prime-1.23")
+(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-1.23")
+
+(run-delay-if-full-flag
+ (delay
+ (let ((port (open-output-file "primes-half.txt")))
+
+ (define (runtime)
+ (time-nanosecond (current-time time-process)))
+
+ (define (display x)
+ (format port "~a" x))
+
+ (define (newline)
+ (format port "\n"))
+
+ (define (timed-prime-test n)
+ ;; (newline)
+ ;; (display n)
+ (start-timed-test n (runtime)))
+
+ (define (start-timed-test n start-time)
+ (cond
+ ((prime? n)
+ (newline)
+ (display "[")
+ (display n)
+ (report-prime (- (runtime)
+ start-time)))
+ (else #f)))
+
+ (define (report-prime elapsed-time)
+ (display ", ")
+ (display elapsed-time)
+ (display "],")
+ (newline)
+ #t)
+
+ (define (search-for-primes start-number end-number)
+ (cond
+ ((> start-number end-number) '())
+ ((timed-prime-test start-number)
+ (cons start-number
+ (search-for-primes (+ start-number 2) end-number)))
+ (else (search-for-primes (+ start-number 2) end-number))))
+
+ (display "[")
+
+ (search-for-primes 3 100001)
+
+ (display "]")
+ (newline))))
+
+;; Exercise 1.24
+
+
+(run-delay-if-full-flag
+ (delay
+ (let ((port (open-output-file "primes-fast-prime.txt")))
+
+ (define (runtime)
+ (time-nanosecond (current-time time-process)))
+
+ (define (display x)
+ (format port "~a" x))
+
+ (define (newline)
+ (format port "\n"))
+
+ (define (timed-prime-test n)
+ ;; (newline)
+ ;; (display n)
+ (start-timed-test n (runtime)))
+
+ (define (start-timed-test n start-time)
+ (cond
+ ((fast-prime? n (inexact->exact (ceiling (* n 0.01))))
+ (newline)
+ (display "[")
+ (display n)
+ (report-prime (- (runtime)
+ start-time)))
+ (else #f)))
+
+ (define (report-prime elapsed-time)
+ (display ", ")
+ (display elapsed-time)
+ (display "],")
+ (newline)
+ #t)
+
+ (define (search-for-primes start-number end-number)
+ (cond
+ ((> start-number end-number) '())
+ ((timed-prime-test start-number)
+ (cons start-number
+ (search-for-primes (+ start-number 2) end-number)))
+ (else (search-for-primes (+ start-number 2) end-number))))
+
+ (display "[")
+
+ (search-for-primes 3 100001)
+
+ (display "]")
+ (newline))))
+
+;; Exercise 2.1
+
+(define (make-rat n d)
+ (define g (gcd n d))
+ (define sign (if (or (and (< n 0)
+ (> d 0))
+ (and (> n 0)
+ (< d 0)))
+ -1
+ 1))
+ (cons (* sign
+ (abs (/ n g)))
+ (abs (/ d g))))
+
+(test-begin "2.1")
+(let ()
+ (define (make-test)
+ (define n-sign (1- (* 2
+ (random 2))))
+ (define d-sign (1- (* 2
+ (random 2))))
+ (define n (* n-sign
+ (random 100)))
+ (define d (* d-sign
+ (1+ (random 100))))
+
+ (define built-in-rational (/ n d))
+ (define ratsui (cons (numerator built-in-rational)
+ (denominator built-in-rational)))
+ (define matsui (make-rat n d))
+ (test-equal (list n d ratsui) (list n d matsui)))
+
+ (for-each (lambda (_) (make-test)) (iota 100)))
+(test-end "2.1")
+
+;; Exercise 2.2
+
+(define (make-point x y)
+ (cons x y))
+
+(define (x-point p) (car p))
+
+(define (y-point p) (cdr p))
+
+(define (make-segment p-start p-end)
+ (cons p-start p-end))
+
+(define (start-segment s) (car s))
+
+(define (end-segment s) (cdr s))
+
+(define (midpoint-segment s)
+ (define start (start-segment s))
+ (define end (end-segment s))
+
+ (make-point (/ (- (x-point end)
+ (x-point start))
+ 2)
+ (/ (- (y-point end)
+ (y-point start))
+ 2)))
+
+(test-begin "2.2")
+(test-equal
+ (make-point 5 2)
+ (midpoint-segment (make-segment (make-point 0 0)
+ (make-point 10 4)))
+)
+(test-end)
+
+;; Exercise 2.3
+
+(define (make-rectangle segment angle)
+ '())
+
+;; Exercise 2.4
+
+(test-begin "2.4")
+
+(let ((cons (lambda (x y) (lambda (m) (m x y))))
+ (car (lambda (z) (z (lambda (p q) p))))
+ (cdr (lambda (z) (z (lambda (p q) q)))))
+
+
+ (for-each
+ (lambda (matsui) (test-equal 'x matsui))
+ (list (car (cons 'x 'y))
+ (car (lambda (m) (m 'x 'y)))
+ ((lambda (m) (m 'x 'y)) (lambda (p q) p))
+ ((lambda (p q) p) 'x 'y)))
+ (for-each
+ (lambda (matsui) (test-equal 'y matsui))
+ (list (cdr (cons 'x 'y))
+ (cdr (lambda (m) (m 'x 'y)))
+ ((lambda (m) (m 'x 'y)) (lambda (p q) q))
+ ((lambda (p q) q) 'x 'y))))
+
+(test-end "2.4")
+
+;; Exercise 2.5
+
+(define (power a b)
+ (define (power' a b result)
+ (cond
+ ((= b 0) result)
+ (else (power' a (1- b) (* a result)))))
+ (power' a b 1))
+
+(test-begin "power")
+(test-equal 8 (power 2 3))
+(test-end "power")
+
+(define (exercise-2.5)
+ (define (cons a b)
+ (* (power 2 a)
+ (power 3 b)))
+
+ (define (car z)
+ (define (car' z result)
+ (cond
+ ((odd? z) result)
+ (else (car' (/ z 2)
+ (1+ result)))))
+
+ (car' z 0))
+
+ (define (cdr z)
+ (define (cdr' z result)
+ (cond
+ ((not (= (remainder z 3) 0)) result)
+ (else (cdr' (/ z 3)
+ (1+ result)))))
+
+ (cdr' z 0))
+
+ (test-begin "2.5")
+ (do-ec (: a 1 10)
+ (: b 1 10)
+ (test-equal
+ (list a b)
+ (list (car (cons a b))
+ (cdr (cons a b)))))
+ (test-end "2.5"))
+
+(exercise-2.5)
+
+;; Exercise 2.6
+
+(define (exercise-2.6)
+ (define zero
+ (lambda (f)
+ (lambda (x)
+ x)))
+
+ (define (add-1 n)
+ (lambda (f)
+ (lambda (x)
+ (f ((n f) x)))))
+
+ (add-1 zero)
+
+ (lambda (f)
+ (lambda (x)
+ (f ((zero f) x))))
+
+ (lambda (f)
+ (lambda (x)
+ (f (((lambda (f)
+ (lambda (x) x)) f) x))))
+ (lambda (f)
+ (lambda (x)
+ (f ((lambda (x) x) x))))
+
+ (define one
+ (lambda (f)
+ (lambda (x)
+ (f x))))
+
+ (add-1 one)
+
+ (lambda (f)
+ (lambda (x)
+ (f ((one f) x))))
+
+ (lambda (f)
+ (lambda (x)
+ (f (((lambda (f)
+ (lambda (x)
+ (f x))) f) x))))
+
+ (lambda (f)
+ (lambda (x)
+ (f ((lambda (x)
+ (f x)) x))))
+
+ (lambda (f)
+ (lambda (x)
+ (f (f x))))
+
+ (define two
+ (lambda (f)
+ (lambda (x)
+ (f (f x)))))
+
+ (define (church-+ a b)
+ (lambda (f)
+ (lambda (x)
+ ((b f) ((a f) x)))))
+
+ (test-begin "2.6")
+ (test-equal 0 ((zero 1+) 0))
+ (test-equal 1 (((add-1 zero) 1+) 0))
+ (test-equal 1 ((one 1+) 0))
+ (test-equal 2 (((add-1 (add-1 zero)) 1+) 0))
+ (test-equal 2 (((add-1 one) 1+) 0))
+ (test-equal 2 ((two 1+) 0))
+ (test-equal 3 (((add-1 two) 1+) 0))
+
+ (do-ec (: elements (list (zip (list zero one two)
+ (iota 3))))
+ (: a elements)
+ (: b elements)
+ (test-equal
+ (+ (cadr a)
+ (cadr b))
+ (((church-+ (car a)
+ (car b)) 1+) 0)))
+ (test-end "2.6"))
+
+(exercise-2.6)
+
+(define (exercise-2.7)
+ (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))
+
+ (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))
+ )
+
+;;;(exercise-2.7)
+
+;; Exercise 2.17
+
+(define (last-pair xs)
+ (cond
+ ((pair? (cdr xs)) (last-pair (cdr xs)))
+ (else xs)))
+
+(test-begin "2.17")
+(test-equal
+ '(3)
+ (last-pair '(1 2 3)))
+(test-end "2.17")
+
+;; Exercise 2.18
+
+(let* ([reverse
+ (lambda (xs)
+ (cond
+ ((null? xs) '())
+ (else (append (reverse (cdr xs))
+ (list (car xs))))))])
+
+ (test-begin "2.18")
+ (test-equal
+ '(3 2 1)
+ (reverse '(1 2 3)))
+ (test-end "2.18"))
+
+;; Exercise 2.19 XXX
+
+;; Exercise 2.20
+
+(define (same-arity n . ns)
+ (define (same-arity' n ns)
+ (cond
+ ((null? ns)
+ (list n))
+ ((or (and (even? n)
+ (even? (car ns)))
+ (and (odd? n)
+ (odd? (car ns))))
+ (cons n
+ (same-arity' (car ns)
+ (cdr ns))))
+ (else
+ (cons n
+ (same-arity' (cadr ns)
+ (cddr ns))))))
+ (same-arity' n ns))
+
+
+(test-begin "2.20")
+(test-equal
+ '(1 3 5 7)
+ (same-arity 1 2 3 4 5 6 7))
+(test-equal
+ '(2 4 6 8)
+ (same-arity 2 3 4 5 6 7 8))
+(test-equal '(1) (same-arity 1))
+(test-equal '(2) (same-arity 2))
+(test-end "2.20")
+
+;; Exercise 2.21
+
+(define (exercise-2.21)
+ (define (square-list-1 items)
+ (if (null? items)
+ '()
+ (cons (* (car items)
+ (car items))
+ (square-list-1 (cdr items)))))
+
+ (define (square-list-2 items)
+ (map (lambda (item)
+ (* item
+ item))
+ items))
+
+ (test-begin "2.21")
+ (test-equal
+ '(1 4 9 16)
+ (square-list-1 '(1 2 3 4)))
+ (test-equal
+ '(1 4 9 16)
+ (square-list-2 '(1 2 3 4)))
+ (test-end "2.21"))
+
+(exercise-2.21)
+
+;; Exercise 2.22
+
+(define (exercise-2.22)
+ (define (square-list-1 items)
+ ;; answer is build by consing the first element of items onto the input nil
+ ;; (item-1 . nil) then the second onto (item-1 . nil), (item-2 . (item-1 . nil))
+ ;; and the third (item-3 . (item-2 . (item-1 . nil))).
+ ;; In other words, you start by consing the first item onto the end of answer
+ ;; and you end by consing the last item of items onto the start of answer,
+ ;; building the cons onion inside out.
+ (define (iter things answer)
+ (if (null? things)
+ answer
+ (iter (cdr things)
+ (cons (* (car things)
+ (car things))
+ answer))))
+ (iter items '()))
+
+ (define (square-list-2 items)
+ ;; In the second attempt you cons the answer to the first item (nil . item-1)
+ ;; then the answer onto the second item ((nil . item-1) item-2) and so on
+ ;; until you cons the answer onto the last item (... . item-n) which is the
+ ;; same as the first attempt, but instead of the accepted
+ ;; items-go-on-car-rest-of-list-goes-on-cdr, you have items-go-on-cdr-rest-of-list-goes-on-car.
+ ;; ((((nil . item-1) . item-2) . item-3) . item-4).
+ (define (iter things answer)
+ (if (null? things)
+ answer
+ (iter (cdr things)
+ (cons answer
+ (* (car things)
+ (car things))))))
+ (iter items '()))
+
+ (test-begin "2.22")
+ (test-equal
+ '(16 9 4 1)
+ (square-list-1 '(1 2 3 4)))
+ (test-equal
+ '((((() . 1) . 4) . 9) . 16)
+ (square-list-2 '(1 2 3 4)))
+ (test-end "2.22"))
+
+(exercise-2.22)
+
+;; Exercise 2.23
+
+(define (exercise-2.23)
+ (define (my-for-each proc lst)
+ (cond
+ ((null? lst)
+ '())
+ (else
+ (proc (car lst))
+ (my-for-each proc
+ (cdr lst)))))
+
+ (define xs (list 1 2 3 4))
+
+ (test-begin "2.23")
+ (test-equal
+ '(1 2 3 4 5 6)
+ (begin
+ (my-for-each (lambda (x)
+ (set! xs (append xs
+ (list x))))
+ '(5 6))
+ xs))
+ (test-end "2.23"))
+
+(exercise-2.23)
+
+;; Exercise 2.24
+
+;; scheme@(guile-user)> (list 1 (list 2 (list 3 4)))
+;; $1 = (1 (2 (3 4)))
+
+;; -----> [1 |]
+;; |
+;; \--> [| ()]
+;; |
+;; \-> [2 |]
+;; |
+;; \-> [| ()]
+;; |
+;; \-> [3 |]
+;; |
+;; \-> [4 ()]
+
+;; (1 (2 (3 4)))
+;; /\
+;; 1 (2 (3 4))
+;; /\
+;; 2 (3 4)
+;; /\
+;; 3 4
+
+(let* ([xs-34 (list 3 4)]
+ [xs-234 (list 2 xs-34)]
+ [xs-1234 (list 1 xs-234)])
+ (test-begin "2.24")
+ (test-equal
+ (list 1
+ (list 2
+ (list 3
+ 4)))
+ (cons 1
+ (cons (cons 2
+ (cons (cons 3
+ (cons 4
+ '()))
+ '()))
+ '())))
+ (test-equal
+ (list 1
+ (list 2
+ (list 3
+ 4)))
+ '(1 . ((2 . ((3 . (4 . ())) . ())) . ())))
+ (test-equal
+ (list 1 (list 2 (list 3 4)))
+ (cons 1
+ (cons (cons 2
+ (cons xs-34
+ '()))
+ '())))
+ (test-equal
+ (list 1 (list 2 (list 3 4)))
+ (cons 1
+ (cons xs-234
+ '())))
+ (test-equal
+ (list 1 (list 2 (list 3 4)))
+ xs-1234)
+ (test-end "2.24"))
