SICP Exercises

Chapter 1
Chapter 2

Chapter 1

Notes

A recursive procedure is simply one that calls itself by name. It is not necessarily a recursive process.

Programs must be written for people to read, and only incidentally for computers to execute

The set of expressions for which a binding defines a name is called the scope of that name

let is syntactic sugar for lambda application

The general technique of isolating the parts of a program that deal with how data objects are represented from the parts of a program that deal with how data objects are used is a powerful design methodology called "data abstraction".

Section 1.1

Exercise 1.3

(define (square x)
  (* x x))
(define (sum-of-squares-of-largest a b c)
  (- (+ (square a) (square b) (square c))
     (cond ((and (< a b) (< a c)) a)
           ((< b c) b)
           (else c))))

Exercise 1.6

Enters a recursive loop not because cond is used instead of if but because a function call is used instead of if or cond. If new-if were implemented with if instead of cond, the code would also enter an infinite loop.

Section 1.2

Exercise 1.9

Recursive:

(+ 4 5)
(inc (+ (dec 4) 5))
(inc (+ 3 5))
(inc (inc (+ (dec 3) 5)))
(inc (inc (+ 2 5)))
(inc (inc (inc (+ (dec 2) 5))))
(inc (inc (inc (+ 1 5))))
(inc (inc (inc (inc (+ (dec 1) 5)))))
(inc (inc (inc (inc (+ 0 5)))))
(inc (inc (inc (inc 5))))
(inc (inc (inc 6)))
(inc (inc 7))
(inc 8)
9

Iterative:

(+ 4 5)
(+ (dec 4) (inc 5))
(+ 3 6)
(+ (dec 3) (inc 6))
(+ 2 7)
(+ (dec 2) (inc 7))
(+ 1 8)
(+ (dec 1) (inc 8))
(+ 0 9)
9

(define (my-count-change amt values)
  (cond ((null? values) 0)
        ((< amt 0) 0)
        ((= amt 0) 1)
        (else (+ (my-count-change (- amt (car values)) values)
                 (my-count-change amt (cdr values))))))

(define (count-change amt)
  (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)))
  (cc amt 5))

Exercise 1.11

(define (f n)
  (if (< n 3)
      n
      (+ (* 1 (f (- n 1)))
         (* 2 (f (- n 2)))
         (* 3 (f (- n 3))))))
(define (f-iter n)
  (define (iterate a b c count)
    (if (= count 0)
        a
        (iterate b
                c
                (+ c
                   (* b 2)
                   (* a 3))
                (- count 1))))
  (iterate 0 1 2 n))

Exercise 1.12

(define (pascal n m)
  (if (or (= m 0)
          (= m n))
      1
      (+ (pascal (- n 1) (- m 1))
         (pascal (- n 1) m))))

Exercise 1.16

If $n$ is even: \[b \to b^{2}\] \[n \to \frac{n}{2} - 1\] \[c \to cb^{2}\] If $n$ is odd: \[b \to b\] \[n \to n - 1\] \[c \to cb\]

(define (fast-expt base exp)
  (define (fast-iter b n c)
    (cond ((= n 0) c)
          ((even? n) (fast-iter (* b b) (- (/ n 2) 1) (* c (* b b))))
          (else (fast-iter b (- n 1) (* c b)))))
  (fast-iter base exp 1))
(define (even? n)
  (= (remainder n 2) 0))

;; And so here are all of the combinations of space-/time-complexity
;; we've seen so far:

(define (my-expt b n)
  (if (= n 0)
      1
      (* b (my-expt b (- n 1)))))

(define (my-expt-iter base pow)
  (define (iterate n c)
    (cond ((= n 0) c)
          (else (iterate (- n 1) (* base c)))))
  (iterate pow 1))

(define (my-expt-log base pow)
  (cond ((= pow 0) 1)
        ((even? pow) (square (my-expt-log base (/ pow 2))))
        (else (* base (my-expt-log base (- pow 1))))))

(define (my-expt-iter-log base pow)
  (define (iterate b p c)
    (cond ((= p 0) c)
          ((even? p) (iterate (* b b) (/ p 2) c))
          (else (iterate b (- p 1) (* b c)))))
  (iterate base pow 1))

Exercise 1.17

(define (halve b)
  (/ b 2))
(define (double b)
  (+ b b))
(define (mult a b)
  (cond ((= b 0) 0)
        ((even? b) (double (mult a (halve b))))
        (else (+ a (mult a (- b 1))))))

Exercise 1.18

(define (fast-mult x y)
  (define (fast-mult-iter a b c)
    (cond ((= b 0) c)
          ((even? b) (fast-mult-iter (double a) (- (halve b) 1) (+ c (double a))))
          (else (fast-mult-iter a (- b 1) (+ c a)))))
  (fast-mult-iter x y 0))

Exercise 1.19

If we use as a representation for the iterative fibonacci process a transformation $T_{p,q}$ defined as: \[a \leftarrow bq + aq + ap\] \[b \leftarrow bp + aq\] Then $t_p',q' = $T_{p,q} \circ T_{p,q}$ is: \[a \leftarrow (bp + aq)q + (bq + aq + ap)q + (bq + aq + ap)p\] \[b \leftarrow (bp + aq)p + (bq + aq + ap)q\] We'll rewrite this to determine p' and q': \[a \leftarrow b(2pq+q^2) + a(2q^2 + 2qp + p^2)\] \[b \leftarrow b(p^2+q^2) + a(2qp+q^2)\] Therefore $p' = p^2+q^2$ and $q' = 2pq+q^2$.

The exercise doesn't elucidate the origin of this cleverly defined transformation. Apparently it's called the "Fibonacci Q-Matrix" and originated in the 1950s (see stackoverflow for more).

(define (fib n)
  (define (fib-iter a b p q count)
    (cond ((= count 0) b)
          ((even? count)
           (fib-iter a
                     b
                     (+ (square p) (square q))
                     (+ (* 2 p q) (square q))
                     (/ count 2)))
          (else (fib-iter (+ (* b q) (* a q) (* a p))
                          (+ (* b p) (* a q))
                          p
                          q
                          (- count 1)))))
  (fib-iter 1 0 0 1 n))

(define (my-expmod base exp mod)
  "Generates an iterative process that runs in a logarithmic number of steps"
  (define (iterate b e i)
    (cond ((= e 0) i)
          ((even? e) (iterate (remainder (* b b) mod) (/ e 2) i))
          (else (iterate b (- e 1) (remainder (* b i) mod)))))
  (iterate base exp 1))

Exercise 1.22

(define (timed-prime-test n)
  (newline)
  (display n)
  (start-prime-test n (runtime)))
(define (start-prime-test n start-time)
  (if (prime? n)
      (report-prime (- (runtime) start-time))))
(define (report-prime elapsed-time)
  (display " *** ")
  (display elapsed-time))
(define (search-for-primes a b)
  (cond ((< a b) (timed-prime-test a)
                 (search-for-primes (+ a 1) b))))
(define (prime? n)
  (define (iterate i)
    (cond ((= (remainder n i) 0) #f)
          ((> (* i i) n) #t)
          (else (iterate (+ i 1)))))
  (iterate 2))

Exercise 1.26

From a high level, calling expmod with (/ exp 2) halves the problem. It is this halving, at each iteration of the process, that allows it to run in a number of steps that is logarithmically related to the size of the input. When Louis calls expmod twice, each with a halved problem (the same half) he is doing twice of half of the original amount of work. Therefore he is doing the original amount of work, which in the case of computing an exponent would be $n$ multiplications where $n$ is the power being raised to.

Exercise 1.27

(define (fermat-condition? a n)
  (= (my-expmod a n n) (remainder a n)))
(define (fermat-test? n)
  (define (satisfies? a)
    (cond ((>= a n) #t)
          ((fermat-condition? a n) (satisfies? (+ a 1)))
          (else #f)))
  (satisfies? 2))
(define (carmichael? n)
  (and (not (prime? n)) (fermat-test? n)))

Section 1.3

Exercise 1.29

(define (simp f a b n)
  (define h (/ (- b a) n))
  (define (step x) (+ x h h))
  (define (cf c x) (* c (f x)))
  (define (2f x) (cf 2 x))
  (define (4f x) (cf 4 x))
  (* (/ h 3.0)
     (+ (f a)
        (sum 4f (+ a h) step b)
        (sum 2f (+ a h h) step b)
        (f b))))

Exercise 1.30

(define (sum term a next b)
  (define (iter a result)
     (if (> a b)
         result
         (iter (next a) (+ result (term a)))))
  (iter a 0))

Exercise 1.31

(define (product-iter term a next b)
  (define (iter a result)
    (if (> a b)
        result
        (iter (next a) (* result (term a)))))
  (iter a 1))
(define (product term a next b)
  (if (> a b)
      1
      (* (term a)
         (product term (next a) next b))))

Exercise 1.32

(define (accumulate combiner null-val term a next b)
  (if (> a b)
      null-val
      (combiner (term a)
                (accumulate combiner null-val term (next a) next b))))
(define (accumulate-iter combiner null-val term a next b)
  (define (iter a result)
    (if (> a b)
        result
        (iter (next a) (combiner result (term a)))))
  (iter a null-val))

Exercise 1.33

(define (filtered-accumulate filter combiner null-val term a next b)
  (define (iter a result)
    (cond ((> a b) result)
          ((filter a) (iter (next a) (combiner result (term a))))
          (else (iter (next a) (combiner result null-val)))))
  (iter a null-val))
(define (sum-square-primes a b)
  (filtered-accumulate prime? + 0 square a inc b))
(define (product-coprimes n)
  (define (filt a)
    (= (gcd a n) 1))
  (filtered-accumulate filt * 1 (lambda (x) x) 2 inc n))
(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))

(define (factorial b)
  (product (lambda (x) x) 2 (lambda (x) (+ x 1)) b))

(define (4square x)
  (* 4 (square x)))
(define (4square1 x)
  (- (4square x) 1))
(define (inc x)
  (+ x 1))
(define (pi-approx n)
  (* 2.0 (/ (product-iter 4square 1 inc n)
            (product-iter 4square1 1 inc n))))

Exercise 1.35

\[x^{2} \mapsto x + 1\] \[x^{2} - x - 1 = 0\] \[x = \frac{-(-1) \pm \sqrt{(-1)^{2} - 4(-1)}}{2}\] \[x = \frac{1 \pm \sqrt{5}}{2}\]

Exercise 1.36

(define tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (newline)
    (display guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

Exercise 1.37

(define (cont-frac n d k)
  (define (recurse i)
    (if (= i k)
        0
        (/ (n i)
           (+ (d i) (recurse (+ i 1))))))
  (recurse 1))
(define (cont-frac n d k)
  (define (iter i result)
    (if (= i 0)
        result
        (iter (- i 1) (/ (n i)
                         (+ (d i) result)))))
  (iter k 0))

Exercise 1.38

(define (e-approx k)
  (define (d k)
    (if (= (remainder k 3) 2)
        (+ 2.0 (* 2 (quotient k 3)))
        1.0))
  (+ 2 (cont-frac (lambda (x) 1.0) d k)))

Exercise 1.39

(define (tan-cf x k)
  (cont-frac (lambda (i) (if (= i 1)
                             x
                             (* -1.0 (square x))))
             (lambda (i) (- (* 2 i) 1.0))
             k))

Exercise 1.40

(define (cubic a b c)
  (lambda (x) (+ (cube x) (* a (square x)) (* b x) c)))

Exercise 1.41

(define (double f)
  (lambda (x) (f (f x))))

Exercise 1.42

(define (compose f g)
  (lambda (x) (f (g x))))

Exercise 1.43

(define (repeated f n)
  (if (= n 1)
      f
      (compose f (repeated f (- n 1)))))
(define (repeated-iter f n)
  (define (iter i g)
    (if (= i n)
        g
        (iter (+ i 1) (compose f g))))
  (iter 1 f))
(define (repeated-log f n)
  (cond ((= n 1) f)
        ((even? n) (repeated-log (compose f f) (/ n 2)))
        (else (compose f (repeated-log f (- n 1))))))

Exercise 1.44

(define (sum-list l)
  (if (null? l)
      0
      (+ (car l) (sum-list (cdr l)))))
(define (average-list l)
  (/ (sum-list l) (length l)))
(define (smooth f)
  (lambda (x) (average-list (list (f (- x dx))
                                  (f x)
                                  (f (+ x dx))))))
(define (n-fold-smoothed f n)
  ((repeated smooth n) f))

Exercise 1.45

In the REPL I see the following:

One average-damp works until fourth roots
Two average-damp's work until eighth roots
Three average-damp's work until sixteenth roots

I see a pattern…

(define (average-damp f)
  (lambda (x) (average (list x (f x)))))
(define (sqrt x)
  (fixed-point (average-damp (lambda (y) (/ x y)))
               1.0))
(define (lb x)
  (/ (log x) (log 2)))
(define (nth-root k n)
  (fixed-point
   ((repeated average-damp (floor (lb n))) (lambda (x) (/ k (my-expt x (- n 1)))))
   1.0))
(define (difference a b)
  (abs (- a b)))
(define (test-nth-root base exp)
  (< (difference base
                 (nth-root (my-expt base exp)
                           exp))
     0.01))

Exercise 1.46

(define (iterative-improve good-enough? improve-guess)
  (lambda (guess)
    (define (iterate g)
      (if (good-enough? g)
          g
          (iterate (improve-guess g))))
    (iterate guess)))
(define (iterative-improve-sqrt x)
  ((iterative-improve (lambda (g) (< (difference (square g) x) 0.001))
                      (lambda (g) (average (list g (/ x g))))) 1.0))
(define (iterative-improve-fixed-point func first-guess)
  ((iterative-improve (lambda (g) (< (difference g (func g)) 0.00001))
                      func) first-guess))

Chapter 2

Section 2.1

Exercise 2.1

(define (same-sign? a b)
  (> (* a b) 0))
(define (make-rat n d)
  (let ((g (gcd n d)))
    (cons (* (cond ((same-sign? n d) 1)
                   (else -1))
             (abs (/ n g)))
          (abs (/ d g)))))
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (print-rat x)
  (newline)
  (display (numer x))
  (display "/")
  (display (denom x)))

Exercise 2.2

(define (make-point x y)
  (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (point-less p1 p2)
  (or (< (x-point p1) (x-point p2))
      (and (= (x-point p1) (x-point p2))
           (< (y-point p1) (y-point p2)))))
(define (point-equal p1 p2)
  (and (= (x-point p1) (x-point p2))
       (= (y-point p1) (y-point p2))))
(define (point-equal p1 p2)
  (and (not (point-less p1 p2))
       (not (point-less p2 p1))))
(define (make-segment start end)
  (cond ((point-less start end) (cons start end))
        (else (cons end start))))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))
(define (average a b)
  (/ (+ a b) 2))
(define (midpoint-segment seg)
  (make-point (average (x-point (start-segment seg))
                       (x-point (end-segment seg)))
              (average (y-point (start-segment seg))
                       (y-point (end-segment seg)))))
(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

Exercise 2.3

(define (make-rectangle corner1 corner2)
  (cond ((or (= (x-point corner1) (x-point corner2))
             (= (y-point corner1) (y-point corner2)))
         (error "Points define a segment"))
        ((point-less corner1 corner2) (cons corner1 corner2))
        (else (cons corner2 corner1))))
(define (height rect)
  (difference (y-point (car rect)) (y-point (cdr rect))))
(define (width rect)
  (difference (x-point (car rect)) (x-point (cdr rect))))

I won't get much more out of this by continuing…

Exercise 2.4

(define (my-cons x y)
  (lambda (m) (m x y)))
(define (my-car z)
  (z (lambda (p q) p)))
(define (my-cdr z)
  (z (lambda (p q) q)))

Expansion:

(my-cdr (my-cons 1 2))
((my-cons 1 2) (lambda (p q) q))
((lambda (m) (m 1 2)) (lambda (p q) q))
((lambda (p q) q) 1 2)
2

Exercise 2.5

(define (log-base base value)
  (/ (log value) (log base)))
(define (factor-out factor value)
  (if (= (remainder value factor) 0)
      (factor-out factor (/ value factor))
      value))
(define (my-cons x y)
  (* (my-expt 2 x) (my-expt 3 y)))
(define (my-car p)
  (log-base 2 (factor-out 3 p)))
(define (my-cdr p)
  (log-base 3 (factor-out 2 p)))

Exercise 2.6

(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

Expansion:

(add-1 zero)
(lambda (f) (lambda (x) (f ((zero f) x))))
(lambda (f) (lambda (x) (f (((lambda (q) (lambda (z) z)) f) x))))
(lambda (f) (lambda (x) (f ((lambda (z) z) x))))
(lambda (f) (lambda (x) (f x)))
(lambda (f) (lambda (x) (f x)))
(add-1 (lambda (f) (lambda (x) (f x))))
(lambda (f) (lambda (x) (f (((lambda (g) (lambda (x) (g x))) f) x))))
(lambda (f) (lambda (x) (f ((lambda (x) (f x)) x))))
(lambda (f) (lambda (x) (f (f x))))

(define (plus a b)
  (lambda (f) (compose (a f) (b f))))

Exercise 2.7

(define (make-interval a b) (cons a b))
(define (lower-bound int)
  (min (car int) (cdr int)))
(define (upper-bound int)
  (max (car int) (cdr int)))

Exercise 2.8

(define (sub-interval x y)
  (make-interval (- (lower-bound x) (upper-bound y))
                 (- (upper-bound x) (lower-bound y))))

Exercise 2.9

Let $x = (a,b)$ and $y = (c,d)$ be intervals. Then $width(x) = \frac{b-a}{2}$ and $width(y) = \frac{d-c}{2}$. Well: \[width(x+y) = width((a+c,b+d))\] \[= \frac{b+d-a-c}{2}\] \[= \frac{b-a}{2} + \frac{d-c}{2}\] \[= width(x)+width(y)\] And: \[width(x-y) = width((a-d,b-c))\] \[= \frac{b-c-a+d}{2}\] \[= width(x) + width(y)\] Now let $x_{1} = (1,2)$, $x_{2} = (3,4)$, and $x_{3} = (5,6)$. Then \[width(x_{1}) = width(x_{2}) = width(x_{3}) = \frac{1}{2}\] But $width(x_{1}*x_{2}) = width((3,8)) = \frac{5}{2}$ and $width(x_{2}*x_{3}) = width(15 24) = \frac{9}{2}$. If product width were a function only of factor widths then $width(x_{1}*x_{2})$ would equal $width(x_{2}*x_{3})$ (because $width(x_{1}) = width(x_{2}) = width(x_{3})$) but this is not the case. Similarly, \[width(\frac{x_{1}}{x_{2}}) = width((\frac{1}{4},\frac{2}{3})) = \frac{5}{24}\] \[\neq width(\frac{x_{2}}{x_{3}}) = width((\frac{1}{3},\frac{4}{5})) = \frac{7}{30}\]

Exercise 2.10

(define (width-interval x)
  (/ (- (upper-bound x) (lower-bound x)) 2))
(define (mul-interval x y)
       (let ((p1 (* (lower-bound x) (lower-bound y)))
             (p2 (* (lower-bound x) (upper-bound y)))
             (p3 (* (upper-bound x) (lower-bound y)))
             (p4 (* (upper-bound x) (upper-bound y))))
         (make-interval (min p1 p2 p3 p4)
                        (max p1 p2 p3 p4))))
(define (div-interval x y)
  (if (= (width-interval y) 0)
      (error "Division by zero-width interval")
      (mul-interval x
      (make-interval (/ 1.0 (upper-bound y))
      (/ 1.0 (lower-bound y))))))

Exercise 2.11

If we're multiplying intervals $i=(a,b)$ and $j=(x,y)$ then we must have $a \leq b$ and $x \leq y$ and so we have the following cases:

	$a \leq b < 0$	$a < 0 \leq b$	$0 \leq a \leq b$
$x \leq y < 0$	$(by,ax)$	$(bx,ax)$	$(bx,ay)$
$x < 0 \leq y$	$(ay,ax)$	$(min(ay,bx),min(ax,by))$	$(bx,by)$
$0 \leq x \leq y$	$(ay,bx)$	$(ay,by)$	$(ax,by)$

For simplicity's sake, we notice that multiplication is commutative and simplify our table:

	$a \leq b < 0$	$a < 0 \leq b$	$0 \leq a \leq b$
$x \leq y < 0$	$(by,ax)$	$(bx,ax)$	$(bx,ay)$
$x < 0 \leq y$	$j*i$	$(min(ay,bx),min(ax,by))$	$(bx,by)$
$0 \leq x \leq y$	$j*i$	$j*i$	$(ax,by)$

(define (mul-interval i j)
  (let ((a (lower-bound i))
        (b (upper-bound i))
        (x (lower-bound j))
        (y (upper-bound j)))
    (cond ((< b 0) (if (< y 0)
                       (make-interval (* b y) (* a x))
                       (mul-interval j i)))
          ((< a 0) (cond ((< y 0) (make-interval (* b x) (* a x)))
                         ((< x 0) (make-interval (min (* a y) (* b x))
                                                 (max (* a x) (* b y))))
                         (else (mul-interval j i))))
          (else (cond ((< y 0) (make-interval (* b x) (* a y)))
                      ((< x 0) (make-interval (* b x) (* b y)))
                      (else (make-interval (* a x) (* b y))))))))

Exercise 2.12

(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))  
(define (make-center-percent c p)
  (make-center-width c (* c p)))
(define (percent i)
  (/ (width i) (center i)))

Exercise 2.13

Let interval $i$ have center $c_{i}$ and tolerance $p_{i}$. Let interval $j$ have center $c_{j}$ and tolerance $p_{j}$. Then $i = (c_{i}-c_{i}p_{i},c_{i}+c_{i}p_{i})$ and $j = (c_{j}-c_{j}p_{j},c_{j}+c_{j}p_{j})$. Suppose $c_{i} > 0$ and $c_{j} > 0$. Then \[i*j = ((c_{i}-c_{i}p_{i})*(c_{j}-c_{j}p_{j}),(c_{i}+c_{i}p_{i})*(c_{j}+c_{j}p_{j}))\] \[= (c_{i}(1-p_{i})c_{j}(1-p_{j}),c_{i}(1+p_{i})c_{j}(1+p_{j}))\] \[= (c_{i}c_{j}(1-p_{i})(1-p_{j}),c_{i}c_{j}(1+p_{i})(1+p_{j}))\] Supposing small percentage tolerances: \[= (c_{i}c_{j}(1-p_{i}-p_{j}),c_{i}c_{j}(1+p_{i}+p_{j}))\] Therefore $i*j$ is an interval centered at $c_{i}c_{j}$ with tolerance $p_{i}+p_{j}$.

Exercise 2.14

(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))
(define (par1 r1 r2)
  (div-interval (mul-interval r1 r2)
                (add-interval r1 r2)))

  (define (par2 r1 r2)
    (let ((one (make-interval 1 1)))
      (div-interval one
                    (add-interval (div-interval one r1)
                                  (div-interval one r2)))))

Let $R_{1} = (a_{1},b_{1})$ and $R_{2} = (a_{2},b_{2})$. Expanding, we see: \[\frac{R_{1}R_{2}}{R_{1}+R_{2}} = (\frac{a_{1}a_{2}}{b_{1}+b_{2}},\frac{b_{1}b_{2}}{a_{1}+a_{2}})\] \[\frac{1}{\frac{1}{R_{1}}+\frac{1}{R_{2}}} = (\frac{a_{1}a_{2}}{a_{1}+a_{2}},\frac{b_{1}b_{2}}{b_{1}+b_{2}})\] This can be verified in the REPL.

Section 2.2

Exercise 2.17

(define (last-pair l)
  (if (null? (cdr l))
      l
      (last-pair (cdr l))))

Exercise 2.18

Note that "nil" is no longer a part of the Scheme standard; we'll use () instead. See this stackoverflow post for more.

(define (reverse l)
  (define (helper in out)
    (if (null? in)
        out
        (helper (cdr in) (cons (car in) out))))
  (helper l ()))

Exercise 2.19

(define no-more? null?)
(define except-first-denomination cdr)
(define first-denomination car)
(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

The order of the list coin-values still does not affect the output because the procedure does not rely on any assumptions regarding the order of coin-values.

Exercise 2.20

(define (same-parity? a b)
  (= (remainder a 2) (remainder b 2)))
(define (same-parity x . l)
  (define (filterer sublist)
    (cond ((null? sublist) sublist)
          ((same-parity? x (car sublist))
           (cons (car sublist) (filterer (cdr sublist))))
          (else (filterer (cdr sublist)))))
  (cons x (filterer l)))

Exercise 2.21

(define (square-list items)
  (if (null? items)
      items
      (cons (square (car items))
            (square-list (cdr items)))))
(define (square-list-map items)
  (map square items))

Exercise 2.22

Elements appearing first in the input list will be added to the head of the ouput list before elements appearing later. Therefore, elements appearing first in the input will appear later in the output.

Now, the output isn't a list.

Exercise 2.23

(define (for-each f l)
  (if (not (null? l))
      (begin (f (car l))
             (for-each f (cdr l)))))

Exercise 2.25

(define l1 (list 1 3 (list 5 7) 9))
(car (cdr (car (cdr (cdr l1)))))
(define l2 (list (list 7)))
(car (car l2))
(define l3 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr l3))))))))))))

Exercise 2.27

(define (deep-reverse l)
  (define (helper in out)
    (if (null? in)
        out
        (helper (cdr in) (cons (deep-reverse (car in)) out))))
  (if (list? l)
      (helper l ())
      l))

Exercise 2.28

(define (fringe tree)
  (cond ((not (list? tree)) (list tree))
        ((not (pair? tree)) tree)
        (else (append (fringe (car tree)) (fringe (cdr tree))))))

Exercise 2.29

(define (left-branch m) (car m))
(define (right-branch m) (car (cdr m)))
(define (branch-length b) (car b))
(define (branch-structure b) (car (cdr b)))
(define (mobile? structure) (pair? structure))
(define (branch-weight b)
  (let ((structure (branch-structure b)))
    (if (mobile? structure)
        (total-weight structure)
        structure)))   
(define (total-weight m)
  (+ (branch-weight (left-branch m))
     (branch-weight (right-branch m))))
(define (mobile-balanced? m)
  (define (branch-balanced? b)
    (let ((structure (branch-structure b)))
      (if (mobile? structure)
          (mobile-balanced? structure)
          #t)))
  (let ((left (left-branch m))
        (right (right-branch m)))
    (and (= (* (branch-length left) (branch-weight left))
            (* (branch-length right) (branch-weight right)))
         (branch-balanced? left)
         (branch-balanced? right))))

Exercise 2.30

(define (square-tree tree)
  (cond ((null? tree) tree)
        ((not (pair? tree)) (square tree))
        (else (cons (square-tree (car tree))
                    (square-tree (cdr tree))))))
(define (square-tree-map tree)
  (map (lambda (subtree)
         (if (not (pair? subtree))
             (square subtree)
             (square-tree-map subtree)))
       tree))

Exercise 2.31

(define (tree-map f t)
  (cond ((null? t) t)
        ((not (pair? t)) (f t))
        (else (cons (tree-map f (car t))
                    (tree-map f (cdr t))))))

Exercise 2.32

The procedure takes advantage of the following observation. If $x$ is an element of set $S$ then we can partition the subsets of $S$ into two categories: those that contain $x$ and those that do not. All of the subsets that do not contain $x$ can be found by recursively finding all of the subsets of $S \setminus {x}$. All of the subsets that do contain $x$ are of the form $x \cup U$ where $U \in \wp (S \setminus {x})$.

(define (subsets s)
  (if (null? s)
      (list ())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (l) (cons (car s) l)) rest)))))

Exercise 2.33

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr 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))

Exercise 2.34

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms)
                (+ (* higher-terms x)
                   this-coeff))
              0
              coefficient-sequence))

Exercise 2.35

(define (count-leaves t)
  (accumulate +
              0
              (map (lambda (elt)
                     (if (pair? elt)
                         (count-leaves elt)
                         1))
                   t)))

Exercise 2.36

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      ()
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

Exercise 2.37

(define (dot-product v w)
  (accumulate + 0 (map * v w)))
(define (matrix-*-vector m v)
  (map (lambda (row)
         (dot-product row v))
       m))
(define (transpose mat)
  (accumulate-n cons () mat))
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (row)
           (map (lambda (col)
                  (dot-product row col))
                cols))
         m)))

Exercise 2.38

(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))
(define fold-right accumulate)

(fold-right / 1 (list 1 2 3)) ; 3/2
(fold-left / 1 (list 1 2 3)) ; 1/6
(fold-right list () (list 1 2 3)) ; (1 (2 (3 ())))
(fold-left list () (list 1 2 3)) ; (((() 1) 2) 3)

Exercise 2.39

(define (reverse sequence)
  (fold-right (lambda (x y) (append y (list x))) () sequence))
(define (reverse sequence)
  (fold-left (lambda (x y) (cons y x)) () sequence))

Exercise 2.40

(define (enumerate-interval k)
  (define (iter curr result)
    (if (= curr 0)
        result
        (iter (- curr 1) (cons curr result))))
  (iter k ()))
(define (unique-pairs n)
  (flatmap (lambda (i)
             (map (lambda (j)
                    (list i j))
                  (enumerate-interval (- i 1))))
           (enumerate-interval n)))

Exercise 2.41

;; This is slow...
(define (unique-tuples n max)
  (cond ((= n 0) (list ()))
        ((< max n) ())
        ((= max n) (list (reverse (enumerate-interval n))))
        (else (append (unique-tuples n (- max 1))
                      (map (lambda (t)
                             (cons max t))
                           (unique-tuples (- n 1) (- max 1)))))))
;; (define (unique-tuples n max)
;;   (define (iter tuples)
;;     (if (= (length (car tuples)) 0)
;;         tuples
;;         (iter (flatmap (lambda (l)
;;                          (if))))))
;;   (if (< max n)
;;       ()
;;       (flatmap values
;;                (iter (map list
;;                           (reverse (enumerate-interval n)))))))
;; ;; And this doesn't work...
;; (define (unique-tuples n max)
;;   (define (next-tuple tuple)
;;     (define (cons-next-tuple min t)
;;       (cond ((null? t) t)
;;             ((null? (cdr t)) t)
;;             ((= (car t) (- (cadr t) 1))
;;              (cons min (cons-next-tuple (+ min 1) (cdr t))))
;;             (else (cons (+ 1 (car t)) (cdr t)))))
;;     (cons-next-tuple 1 tuple))
;;   (define (iter t result)
;;     (if (> (car t) max)
;;         result
;;         (iter (next-tuple t) (cons t result))))
;;   (iter (enumerate-interval n) ()))
(define (sum-list l)
  (fold-left + 0 l))
(define (bounded-partition n parts bound)
  (filter (lambda (t)
            (= n (sum-list t)))
          (unique-tuples parts bound)))
(define (bounded-paritition-3 total bound)
  (bounded-partition total 3 bound))

Exercise 2.42

(define (make-queen row col)
  (list row col))
(define (get-row queen)
  (car queen))
(define (get-col queen)
  (cadr queen))
(define (queens board-size)
  (define (adjoin-position row col board)
    (cons (make-queen row col) board))
  (define (safe? col board)
    (define (same-diag? q1 q2)
      (= (difference (get-row q1) (get-row q2))
         (difference (get-col q1) (get-col q2))))
    (define (same-row? q1 q2)
      (= (get-row q1) (get-row q2)))
    (let ((new-queen (car board)))
      (fold-right (lambda (x y) (and x y))
                  #t
                  (map (lambda (q)
                         (and (not (same-row? new-queen q))
                              (not (same-diag? new-queen q))))
                       (cdr board)))))
  (define empty-board ())
  (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 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))
(define (repeat-display n str)
  (if (> n 0)
      (begin
        (display str)
        (whitespace (- n 1)))))
(define (print-queens board)
  (define (iter left)
    (if (not (null? left))
        (let ((row (get-row (car left))))
          (repeat-display (- row 1) ".")
          (display "Q")
          (repeat-display (- (length board) row) ".")
          (newline)
          (iter (cdr left)))))
  (iter board))
(define (show-queens n)
  (map (lambda (soln)
         (print-queens soln)
         (newline))
       (queens n)))

Exercise 2.43

In the provided queens procedure, the $n \times (k-1)$ subproblem is solved once. Then, for each solution of the subproblem, several candidate solutions for the $n \times k$ problem are created by adding a new column with a queen in each possible row.

Louis's procedure calculates each possible row once (in the call to enumerate-interval). Then, for each row, the procedure calculates the $n \times (k-1)$ subproblem. So, at each level of the process, the subproblem is solved $n$ times. Therefore, in Louis' procedure, the base-case $n \times 0$ problem, computed by (queens 0), is calculated $n^{n}$ times. Louis' procedure solves the puzzle in approximately time $n^{n}T$.

Exercise 2.44

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

Exercise 2.45

(define (split outer inner)
  (lambda (painter n)
    (if (= n 0)
        painter
        (let ((smaller ((split outer inner) painter (- n 1))))
          (outer painter (inner smaller smaller))))))

Exercise 2.46

(define (make-vect x y) (cons x y))
(define (xcor-vect v) (car v))
(define (ycor-vect v) (cdr v))
(define (add-vect v1 v2) )

I'll leave this exercise here.

Exercise 2.47

(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))
(define (origin-frame frame)
  (car frame))
(define (edge1-frame frame)
  (cadr frame))
(define (edge2-frame frame)
  (caddr frame))

(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))
(define (origin-frame frame)
  (car frame))
(define (edge1-frame frame)
  (cadr frame))
(define (edge2-frames frame)
  (cddr frame))

Exercise 2.48

(define (make-segment v1 v2)
  (cons v1 v2))
(define (start-segment v) (car v))
(define (end-segment v) (cdr v))

Exercise 2.49

(define (fold-right op null l)
  (if (null? l)
      null
      (op (car l) (fold-right op null (cdr l)))))
(define (fold-left-iter op null l)
  (define (iter curr result)
    (if (null? curr)
        result
        (iter (cdr curr) (op result (car curr)))))
  (iter l null))
(define (take n l)
  (if (= n 0)
      ()
      (cons (car l) (take (- n 1) (cdr l)))))
(define (rotate-left l n)
  (fold-right cons
              (take n l)
              ((repeated cdr n) l)))
(define (outline f)
  (segments->painter
   (let ((rotl (lambda (l) (fold-right cons (list (car l)) (cdr l)))))
     (let ((x-cors (list 0 0 1 1)))
       (let ((corners (map make-vect x-cors (rotl x-cors))))
         (map make-segment
              corners
              (rotl corners)))))))
(define (x-painter f)
  (segments-painter
   (map make-segment
        (map make-vect
             (list 0 0)
             (list 0 1))
        (map make-vect
             (list 1 1)
             (list 1 0)))))

Exercise 2.51

(define (below p1 p2)
  (rotate90 (beside (rotate270 p2)
                    (rotate270 p1))))

Section 2.3

Exercise 2.53

(list 'a 'b 'c)
(list (list 'george))
(cdr '((x1 x2) (y1 y2)))
(cadr '((x1 x2) (y1 y2)))
(pair? (car '(a short list)))
(memq 'red '((red shoes) (blue socks)))
(memq 'red '(red shoes blue socks))

Exercise 2.54

(define (equal? a b)
  (if (and (pair? a) (pair? b))
      (and (equal? (car a) (car b))
           (equal? (cdr a) (cdr b)))
      (eq? a b)))

Exercise 2.55

Eva types (car ''abracadabra) and the interpreter prints quote. A footnote mentions that ' is implemented as procedure application, and so (car ''abracadabra) is evaluated to (car (quote (quote abracadabra))). Then it makes sense for car of (quote abracadabra) to be quote. To verify this we run the following:

(cdr ''abracadabra)
abracadabra

This is consistent with our explanation.

Exercise 2.56

The provided code:

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (make-sum a1 a2) (list '+ a1 a2))
(define (make-product m1 m2) (list '* m1 m2))
(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
(define (product? x)
  (and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p) (caddr p))
(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))))
        (else
         (error "unknown expression type -- DERIV" exp))))

(define (exponentiation? x)
  (and (pair? x) (eq? (car x) '**)))
(define (base e) (cadr e))
(define (exponent e) (caddr e))
(define (make-exponentiation b p)
  (cond ((=number? p 0) 1)
        ((=number? p 1) b)
        ((and (number? b) (number? p)) (expt b p))
        (else (list '** b p))))
(define (make-difference a b)
  (make-sum a (make-product b -1)))
(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))))
        ((exponentiation? exp)
         (make-product
          (exponent exp)
          (make-product (make-exponentiation
                         (base exp)
                         (make-difference (exponent exp)
                                          1))
                        (deriv (base exp) var))))
        (else
         (error "unknown expression type -- DERIV" exp))))

Exercise 2.57

(define (augend s)
  (if (null? (cdddr s))
      (caddr s)
      (cons '+ (cddr s))))
(define (make-sum a b)
  (let* ((flat (flatmap (lambda (t) (if (sum? t) (cdr t) t))
                        (list a b)))
         (sum (foldl + 0 (filter number? flat)))
         (rest (filter! number? flat)))
    (cond ((null? rest) sum)
          ((= sum 0) (if (null? (cdr rest)) (car rest) (cons '+ rest)))
          (else (cons '+ (cons acc rest))))))
(define (multiplicand p)
  (if (null? (cdddr p))
      (caddr p)
      (cons '* (cddr p))))
(define (make-product a b)
  (let* ((flat (flatmap (lambda (t) (if (sum? t) (cdr t) t))
                        (list a b)))
         (prod (foldl * 1 (filter number? flat)))
         (rest (filter! number? flat)))
    (cond ((null? rest) prod)
          ((= sum 1) (if (null? (cdr rest)) (car rest) (cons '+ rest)))
          ((= sum 0) 0)
          (else (cons '+ (cons acc rest))))))

I tried to refactor make-sum and make-product into a simpler yet meaningful-enough function, to no avail. I'll heed the rule of three for now.

Exercise 2.58

Infix addition:

(define (sum? e)
  (and (pair? e)
       (pair? (cdr e))
       (eq? (cadr e) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list a1 '+ a2))))

The same modifications apply to product?, multiplier, multiplicand, and make-product, mutatis mutandis.

Each element in a given list is a number, a variable, a sum, a product, or a parenthesized expression. If a list has more than one element, it must by a product or a sum. If the list contains both + and *, such as (x + 3 * y) then the list represents a sum, because * binds tighter than +. Therefore, if the list contains even one + then we can consider the expression to the left of the first + the addend and the expression to the right the augend. If a list that has more than one element is not a sum, then it must be a product.

Exercise 2.59

Provided code:

(define (adjoin-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))
(define (element-of-set? x set)
  (cond ((null? set) false)
        ((equal? x (car set)) true)
        (else (element-of-set? x (cdr set)))))
(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) '())
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))

(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        (else (adjoin-set (car set1) (union-set (cdr set1) set2)))))

Exercise 2.60

(define (element-of-set? x set) (memq x set))
(define (adjoin-set x set) (cons x set))
(define (union-set set1 set2) (append set1 set2))
(define (intersection-set set1 set2)
  (filter (lambda (x) (element-of-set? x set2)) set1))

element-of-set? is still an $O(n)$ operation; there's no getting around this. But adjoin-set is now an $O(1)$ operation, and union-set, which is $O(n^{2})$ in my implementation above, is now $O(n)$. intersection-set is still an $O(n^{2})$ operation.

Exercise 2.61

(define (adjoin-set x set)
  (cond ((null? set) (cons x set))
        ((> x (car set)) (cons (car set) (adjoin-set x (cdr set))))
        ((= x (car set)) set)
        (else (cons x set))))

Exercise 2.62

(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        (else (let ((x1 (car set1))
                    (x2 (car set2)))
                (cond ((= x1 x2)
                       (cons x1 (union-set (cdr set1)
                                           (cdr set2))))
                      ((< x1 x2)
                       (cons x1 (union-set (cdr set1)
                                           set2)))
                      ((> x1 x2)
                       (cons x2 (union-set set1
                                           (cdr set2)))))))))

Exercise 2.63

The trees from Figure 2.16:

(define tree-a
  (make-tree
   7
   (make-tree
    3
    (make-tree 1 () ())
    (make-tree 5 () ()))
   (make-tree
    9
    ()
    (make-tree 11 () ()))))
(define tree-b
  (make-tree
   3
   (make-tree 1 () ())
   (make-tree
    7
    (make-tree 5 () ())
    (make-tree
     9
     ()
     (make-tree 11 () ())))))
(define tree-c
  (make-tree
   5
   (make-tree
    3
    (make-tree 1 () ())
    ())
   (make-tree
    9
    (make-tree 7 () ())
    (make-tree 11 () ()))))

tree->list-1 and tree->list-2 result in (1 3 5 7 9 11) for every tree above. Moreover, tree->list-1 and tree->list-2 produce the same result for for any two trees that represent the same set.
tree->list-1 uses append to combine the solutions to the recursively-solved subproblems. This procedure takes time proportional to the size of its first input, namely the left subtree of any given node.

Suppose we have a balanced tree of $n = 2^{k}-1$ nodes (meaning that $k$ is the number of levels in the tree). Level $i$ of the tree (call the root level $0$) has $2^{i}$ nodes. Each of these nodes combines its subproblems in time proportional to the size of its left subtree, which is $2^{k-i-1}$. The total time of the tree is therefore proportional to the following: \[\sum_{i=0}^{k-1} 2^{i}2^{k-i-1} = \sum_{i=0}^{k-1} 2^{k-1} = k2^{k-1} = k\frac{n+1}{2} = \log(n+1)\frac{n+1}{2}\] Therefore the order of growth of tree->list-1 is $O(n\log(n))$.

Perhaps a simpler formula: \[\frac{n}{2}+2\frac{n}{4}+4\frac{n}{8}+\ldots\] \[\frac{n}{2}+\frac{n}{2}+\frac{n}{2}+\ldots\] \[\log(n)\frac{n}{2}\]

On the other hand, tree->list-2 uses cons to combine subproblems, and therefore take $O(1)$ time for each of the $n$ nodes in the tree, for a total of $O(n)$ time.

Exercise 2.64

partial-tree recurses once left and once right at each node to build the tree. Therefore each of the $n$ elements is tree-ified by one call to partial-tree. All of the operations partial-tree used to combine the solutions to the subproblems are $O(1)$, therefore partial-tree takes $O(n)$ time.

Exercise 2.65

(define (union-set set1 set2)
  (list->tree (union-set-list (tree->list-2 set1)
                              (tree->list-2 set2))))

Mutatis mutandis for intersection-set.

Exercise 2.67

(a d a b b c a)

Exercise 2.68

(define (encode-symbol symbol tree)
  (define (encode-1 bits branch)
    (if (leaf? branch)
        bits
        (let ((left (left-branch branch)))
          (if (memq symbol (symbols left))
              (encode-1 (cons 0 bits) left)
              (encode-1 (cons 1 bits) (right-branch branch))))))
  (if (memq symbol (symbols tree))
      (reverse (encode-1 () tree))
      (error "not in tree")))

Exercise 2.69

(define (successive-merge tree-set)
  (cond ((null? tree-set) ())
        ((null? (cdr tree-set)) (car tree-set))
        (else
         (successive-merge (adjoin-set (make-code-tree (car tree-set)
                                                       (cadr tree-set))
                                       (cddr tree-set))))))

Exercise 2.70

(length (encode '(GET A JOB
                  SHA NA NA NA NA NA NA NA NA
                  GET A JOB
                  SHA NA NA NA NA NA NA NA NA
                  WAH YIP YIP YIP YIP YIP YIP YIP YIP YIP
                  SHA BOOM)
                (generate-huffman-tree
                 '((A 2) (NA 16)
                   (BOOM 1) (SHA 3)
                   (GET 2) (YIP 9)
                   (JOB 2) (WAH 1)))))
;Value: 84

A fixed-length code would take at least 3 bits per symbol times 36 symbols for a total of 108 bits.

Exercise 2.71

The trees look like lists: each non-leaf node has one leaf child and one non-leaf child. The most frequent symbol takes one bit, and the least frequent symbol takes $n-1$ bits.

Exercise 2.72

If the relative frequencies are as described in exercise 2.71, then the memq call in encode-1 searches a list of length one at each node, which is a constant-time operation. Therefore each of the $n$ iterations (in the worst case) of encode-1 are constant-time. Therefore encode-1 has growth $O(n)$. reverse and the memq call in encode also have growth $O(n)$, so encode has time-complexity $O(n)$ where $n$ is the number of symbols in the alphabet.

Section 2.4

Exercise 2.73

(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))
        (else ((get 'deriv (operator exp)) (operands exp)
               var))))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))

(define (install-prefix-system)
  (define (deriv-sum sum)
    (make-sum (deriv (addend exp) var)
              (deriv (augend exp) var)))
  (define (deriv-product prod)
    (make-sum
     (make-product (multiplier exp)
                   (deriv (multiplicand exp) var))
     (make-product (deriv (multiplier exp) var)
                   (multiplicand exp))))
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-product))

Section 2.5

Exercise 2.77

magnitude was already defined in 2.4.3 as:

(define (magnitude z) (apply-generic 'magnitude z))

This was done to provide a generic interface for getting the magnitude of a complex number whether it's represented in rectangular or polar coordinates. A function taking a complex number tagged with 'polar and a function taking a complex number tagged with 'rectangular were already added to the table.

Exercise 2.78

(define (attach-tag type-tag contents)
  (if (eq? type-tag 'scheme-number)
      contents
      (cons type-tag contents)))
(define (type-tag datum)
  (cond ((number? datum) 'scheme-number)
        ((pair? datum) (car datum))
        (else (error "Bad tagged datum -- TYPE-TAG" datum))))
(define (contents datum)
  (cond ((number? datum) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum -- CONTENTS" datum))))

Exercise 2.79

The following solution tests equality of numbers in the arithmetic package that have the same type. For a more general approach that allows compation numbers with different types, see Exercise 2.85.

(define (equ?-num a b) (= a b))
(put 'equ? '(scheme-number scheme-number) equ?-num)
(define (equ?-rat a b) (and (= (numer a) (numer b))
                            (= (denom a) (denom b))))
(put 'equ? '(rational rational) equ?-rat)
(define (equ?-complex a b) (and (= (real-part a) (real-part b))
                                (= (imag-part a) (imag-part b))))
(put 'equ? '(complex complex) equ?-complex)
(define (equ? a b) (apply-generic 'equ? a b))

With the current implementation of complex and rational numbers as pairs of scheme numbers, using = within equ?-rat and equ?-complex should work. But because equ? works with scheme-numbers too, recursively testing the components of complex and rational numbers by replacing = with equ? in equ?-rat and equ?-complex will also work with future representations of complex and rational numbers that internally use numbers from our number package…

Exercise 2.80

(define (=zero? x) (apply-generic '=zero? x))
(put '=zero? '(scheme-number) (lambda (x) (= x 0)))
(define (=zero?-complex x)
  (= (magnitude x) 0))
(put '=zero? '(complex) =zero?-complex)
(define (=zero?-rat x)
  (= (numer x) 0))
(put '=zero?-rat '(rational) =zero?-rat)

Exercise 2.81

Infinite recursion: apply-generic coerces the first complex number to a complex number, and calls itself.

Code:

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (if (eq? type1 type2)
                    (error "No method for these types"
                           (list op type-tags))
                    (let ((t1->t2 (get-coercion type1 type2))
                          (t2->t1 (get-coercion type2 type1)))
                      (cond (t1->t2
                             (apply-generic op (t1->t2 a1) a2))
                            (t2->t1
                             (apply-generic op a1 (t2->t1 a2)))
                            (else
                             (error "No method for these types"
                                    (list op type-tags)))))))
              (error "No method for these types"
                     (list op type-tags)))))))

Exercise 2.82

Imagine an arithmetic package for complex, real, and imaginary numbers. Both real and imaginary numbers are subtypes of complex numbers, but real and imaginary numbers are unrelated to each other. If one tried to add a real number and a complex number, this would only be possible if each was converted (raised) to a complex number. With the current type-coercion algorithm, this is not possible.

One way to approach a fully general coercion system for two arguments would be to determine all possible types that the first argument can be coerced into, and, for each of these types, coerce the first argument and retry the operation with each of the possible types of the second argument in turn.

After thinking about this for a while, I do not know enough about the use case to make a satisfactory general procedure. I can imagine situations where:

The arguments can be coereced into new types in multiple valid ways. Which coercions should be preferred?
The arguments can be "downcast". For example, a quadrilateral may happen to be a square, and so it is valid to coerce such a quadrilateral into a square. Should implicit coercion be allowed here?
The only coercion that allows the operation to succeed requires that an argument be coerced into a distant type. Should such coercion happen automatically, or require that the caller be more explicit?

Instead, we will try the more naive method suggested in the exercise:

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (define (fail) (error "No method for these types"
                          (list op type-tags)))
    (define (try-coerce targets)
      (if (null? targets)
          (fail)
          (let* ((targ (car targets))
                 (funcs (filter! null?
                                 (map (lambda (type) (get-coercion type targ))
                                      type-tags))))
            (if (= (length funcs) (length args))
                (let ((proc (get op (repeat (length args) targ))))
                  (if proc
                      (apply proc (map contents (map apply
                                                     funcs
                                                     (map list args))))
                      (try-coerce (cdr targets))))))))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (let ((all-types (remove-duplicates type-tags)))
            (if (length-1 all-types)
                (fail)
                (try-coerce all-types)))))))

Usually, circular inheritance does not make sense. Therefore there cannot be cycles in a general graph of type relationships. Therefore, given two types a and b, at most one type can be an ancestor of the other. If downcasting is to be explicit, then method of attempting to coerce all of the args into the type of the first arg, then the second arg, etc. is equivalent to attempting to coerce all of the args into the type of the arg with the highest type in the hierarchy (because all of the coercions that attempt to coerce the arg with the highest type to any lower type will fail because we've said downcasting is explicit).

Exercise 2.83

(define (int->rat int)
  (make-rational int 1))
(put 'raise 'int int->rat)
(define (rat->real rat)
  (make-real (/ (numer rat) (denom rat))))
(put 'raise 'rat rat->real)
(define (real->complex real)
  (make-complex-real-imag real 0))
(put 'raise 'real raise-real)
(define (raise num)
  ((get 'raise (type-tag num)) (contents num)))

Exercise 2.84

(define (ancestor? arg1 arg2)
  (let ((func (get 'raise (tag arg2))))
    (if func
        (let ((super (func (contents arg2))))
          (if (= (tag super) (tag arg1))
              super
              (ancestor? arg1 super)))
        #f)))
(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (= (length args) 2)
              (let ((a1 (car args))
                    (a2 (cadr args)))
                (let ((a2->type1 (ancestor? a1 a2))
                      (a1->type2 (ancestor? a2 a1)))
                  (cond (a2->type1
                         (apply-generic op a1 a2->type1))
                        (a1->type2
                         (apply-generic op a1->type2 a2))
                        (else
                         (error "No method for these types"
                                (list op type-tags))))))
              (error "No method for these types"
                     (list op type-tags)))))))

Exercise 2.85

(define (project-complex complex)
  (make-real (real-part complex)))
(put 'project 'complex 'project-complex)
(define (project-real real)
  (make-rat (round real) 1))
(put 'project 'real 'project-real)
(define (project-rat rat)
  (make-int (round (/ (numer rat) (denom rat)))))
(put 'project 'rat 'project-rat)
(define (project num) (apply-generic 'project num))
(define (drop num)
  (if (get 'project (type-tag num))
      (let ((projection (project num)))
        (if (equ? num (raise projection))
            (drop (projection))
            num))
      num))
(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (drop (apply proc (map contents args)))
          (if (= (length args) 2)
              (let ((a1 (car args))
                    (a2 (cadr args)))
                (let ((a2->type1 (ancestor? a1 a2))
                      (a1->type2 (ancestor? a2 a1)))
                  (cond (a2->type1
                         (apply-generic op a1 a2->type1))
                        (a1->type2
                         (apply-generic op a1->type2 a2))
                        (else
                         (error "No method for these types"
                                (list op type-tags))))))
              (error "No method for these types"
                     (list op type-tags)))))))

Exercise 2.86

Depending on whether we want to store complex numbers internally as rational numbers (or other future numbers), or just to handle making complex numbers from rational numbers (or other future numbers) we would need to:

Make both of the make-complex-from- procedures generic
Replace +, -, *, and / with add, sub, mul, and div in internal procedures add-complex, sub-complex, etc
Rewrite polar- and rectangular- complex-number pacakges to use generic procedures sine, cosine, atangent, sqrt, plus
Rewrite project-complex and raise-complex

Exercise 2.87

Because =zero? is used in adjoin-term, zero coefficients are left out of polynomials constructed with add and mul. If we rewrite make-poly so that terms with zero coefficients are not actually stored, then any polynomial that can be created will not no terms with zero coefficients. Therefore the zero polynomial will simply have no terms:

(put '=zero? 'poly empty-termlist?)

Exercise 2.88

(define (neg-poly poly)
  (define (neg-terms terms)
    (if (empty-termlist? terms)
        terms
        (let ((first (first-term terms)))
          (adjoin-term (make-term (order first)
                                  (neg (coeff first)))
                       (neg-terms (rest-terms terms))))))
  (make-poly (variable poly)
             (neg-terms (term-list poly))))
(put 'neg 'poly neg-poly)
(define (sub-poly p1 p2) (add-poly p1 (neg p2)))
(put 'sub 'poly sub-poly)

	\(a \leq b < 0\)	\(a < 0 \leq b\)	\(0 \leq a \leq b\)
\(x \leq y < 0\)	\((by,ax)\)	\((bx,ax)\)	\((bx,ay)\)
\(x < 0 \leq y\)	\((ay,ax)\)	\((min(ay,bx),min(ax,by))\)	\((bx,by)\)
\(0 \leq x \leq y\)	\((ay,bx)\)	\((ay,by)\)	\((ax,by)\)

	\(a \leq b < 0\)	\(a < 0 \leq b\)	\(0 \leq a \leq b\)
\(x \leq y < 0\)	\((by,ax)\)	\((bx,ax)\)	\((bx,ay)\)
\(x < 0 \leq y\)	\(j*i\)	\((min(ay,bx),min(ax,by))\)	\((bx,by)\)
\(0 \leq x \leq y\)	\(j*i\)	\(j*i\)	\((ax,by)\)