第二章习题 2.1 - 2.32 的解答。
E-2.1:
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (print-rat x)
(display (numer x))
(display "/")
(display (denom x))
(newline))
; -------------------------------------------
(define (make-rat n d)
(if (or (and (> n 0) (< d 0))
(and (< n 0) (< d 0)))
(cons (- n) (- d))
(cons n d)))
(print-rat (make-rat -3 -4))E-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 start end) (cons start end))
(define (start-segment s) (car s))
(define (end-segment s) (cdr s))
(define (print-point p)
(display "(")
(display (x-point p))
(display ", ")
(display (y-point p))
(display ")")
(newline))
; -------------------------------------------------
(define (average a b) (/ (+ a b) 2))
(define (midpoint-segment s)
(make-point (average (x-point (start-segment s))
(x-point (end-segment s)))
(average (y-point (start-segment s))
(y-point (end-segment s)))))
; -------------------------------------------------
(print-point (midpoint-segment (make-segment (make-point 1 1)
(make-point 2 2))))E-2.3:
(load "2.2.scm")
(define (make-rect top-left bottom-right)
(cons top-left bottom-right))
(define (top-left-rect r) (car r))
(define (bottom-right-rect r) (cdr r))
(define (x-distance left-point right-point)
(- (x-point right-point) (x-point left-point)))
(define (y-distance top-point bottom-point)
(- (y-point bottom-point) (y-point top-point)))
(define (perimeter-rect r)
(* (+ (x-distance (top-left-rect r) (bottom-right-rect r))
(y-distance (top-left-rect r) (bottom-right-rect r)))
2))
(define (area-rect r)
(* (x-distance (top-left-rect r) (bottom-right-rect r))
(y-distance (top-left-rect r) (bottom-right-rect r))))
; -------------------------------------------------
(perimeter-rect (make-rect (make-point 1 3)
(make-point 3 4)))
(area-rect (make-rect (make-point 1 2)
(make-point 3 4)))还可以使用四个点，或者右上和左下两个对角点。
E-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)))
; -----------------------------------------------
(my-car (my-cons 32 45))E-2.5: 刚开始傻里吧唧地复习了一遍对数运算，结果无论怎么算都是 0……其实应该是分别数能被 2 或 3 整除的次数。
(define (my-cons x y)
(* (expt 2 x) (expt 3 y)))
(define (count z base)
(if (= (remainder z base) 0)
(+ 1 (count (/ z base) base))
0))
(define (my-car z)
(count z 2))
(define (my-cdr z)
(count z 3))
; ------------------------------------
(my-car (my-cons 4 9))
(my-cdr (my-cons 4 9))E-2.6: 真的理不清这个结构……
E-2.7: upper-bound 是 (car z)，lower-bound 是 (cdr z)。
E-2.8: 相减的物理意义是两个区间的数之差的上下限。
(define (sub-interval x y)
(make-interval (- (lower-bound x) (upper-bound y))
(- (upper-bound x) (lower-bound y))))E-2.9: 令 w1 = (max1 - min1) / 2，w2 = (max2 - min2) / 2，则 ws = w1 + w2。
E-2.10: 当 lower-bound 小于 0 时返回 0。
E-2.11:
(define (make-interval a b)
(cons a b))
(define (lower-bound x)
(car x))
(define (upper-bound x)
(cdr x))
(define (mul-interval x y)
(let ((a1 (lower-bound x))
(b1 (upper-bound x))
(a2 (lower-bound y))
(b2 (upper-bound y)))
(cond ((and (> a1 0) (> b1 0) (> a2 0) (> b2 0))
(make-interval (* a1 a2) (* b1 b2)))
((and (> a1 0) (> b1 0) (< a2 0) (> b2 0))
(make-interval (* a2 b1) (* b1 b2)))
((and (> a1 0) (> b1 0) (< a2 0) (< a2 0))
(make-interval (* b1 b2) (* a1 a2)))
((and (< a1 0) (> b1 0) (> a2 0) (> b2 0))
(make-interval (* a1 b2) (* b1 b2)))
((and (< a1 0) (> b1 0) (< a2 0) (> b2 0))
(make-interval (min (* a1 b2) (* b1 a2))
(max (* a1 a2) (* b1 b2))))
((and (< a1 0) (> b1 0) (< a2 0) (< b2 0))
(make-interval (* b1 b2) (* a1 a2)))
((and (< a1 0) (< b1 0) (> a2 0) (> b2 0))
(make-interval (* a1 b2) (* b1 a2)))
((and (< a1 0) (< b1 0) (< a2 0) (> b2 0))
(make-interval (* a1 b2) (* a1 a2)))
((and (< a1 0) (< b1 0) (< a2 0) (< b2 0))
(make-interval (* b1 b2) (* a1 a2))))))E-2.12:
(load "../examples/2.1.4-interval-arithmetic.scm")
(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)
(let ((w (* c p)))
(make-interval (- c w) (+ c w))))
(define (percent i)
(/ (width i) (center i)))E-2.13: 没有读懂题目的意思，在网上找了答案才明白（参考资料 [3]）。使用 (中心点，百分比) 的形式表示，设其中一个区间为 (c1, p1)，另一个区间为 (c2, p2)，范围分别为 (c1(1-p1), c2(1+p1)) 和 (c2(1-p2), c2(1+p2))，两者乘积的区间为 (c1c2(1-p1)(1-p2), c1c2(1+p1)(1+p2))。percentage tolerance 的定义是 tolerance/center，即 ((upper - lower)/2) / ((upper + lower)/2)，结果为 (p1 + p2)/(1 + p1p2)，当 p1 和 p2 都很小时约等于 p1+p2。
E-2.14: 两个等式的定义域并不一样，例如 par2 中 R1 和 R2 均不能为 0 但 par1 中可以，因此变形后再计算范围肯定不一样。
E-2.15: 我觉得 par1 较好，因为 par2 中 R1 和 R2 均不能为 0，而在 par1 中可以，例如导线的电阻就可以认为是 0。
E-2.16: 原因就是变形成立的条件必需在两者都有意义的定义域上，否则就会出现不同。参考资料 [4] 给出了一个实现。
E-2.17:
(define (last-pair l)
(define (iter l)
(if (null? (cdr l))
(car l)
(iter (cdr l))))
(iter l))
; ----------------------------------------
(last-pair (list 1 2 3 4))E-2.18:
(define (my-reverse l)
(define (recur l)
(if (null? l)
(list)
(append (recur (cdr l)) (list (car l)))))
(recur l))
; ----------------------------------------
(my-reverse (list 1 4 9 16 25))E-2.19: 很简单的题目，no-more? 对应 null?，except-first-denomination 对应 cdr，first-denomination 对应 car。
E-2.20:
(define (same-parity . l)
(define (recur l remain)
(if (null? l)
(list)
(if (= remain (remainder (car l) 2))
(append (list (car l)) (recur (cdr l) remain))
(recur (cdr l) remain))))
(if (null? l)
(list)
(recur l (remainder (car l) 2))))
; ----------------------------------------------------
(same-parity 1 2 3 4 5 6 7)E-2.21:
(define (square-list items)
(define (square x) (* x x))
(if (null? items)
(list)
(cons (square (car items)) (square-list (cdr items)))))
(define (square-list items)
(map (lambda (x) (* x x)) items))E-2.22: 第一个问题是每次结果都从左边添加，answer 的变化过程为：nil -> (1 nil) -> (4 1 nil) ...。第二个问题刚好相反，整个链表顺序倒过来了，nil 变成了第一个元素。
E-2.23:
(define (my-for-each proc items)
(map proc items))
; ----------------------------------------------------
(my-for-each (lambda (x) (display x) (newline))
(list 57 321 88))E-2.24: (1 (2 (3 4)))
E-2.25:
(define x (list 1 3 (list 5 7) 9))
(car (cdr (car (cdr (cdr x)))))
(define y (list (list 7)))
(car (car y))
(define z (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 z))))))))))))E-2.27: 做了好几天都没做出来，不是这里多了一层就是那里少了一层，最后终于忍不住到网上搜了答案（见参考资料 [1]）。
(define (deep-reverse l)
(cond ((null? l) (list))
((pair? (car l))
(append (deep-reverse (cdr l))
(list (deep-reverse (car l)))))
(else
(append (deep-reverse (cdr l))
(list (car l))))))
; ------------------------------------------------------
(define x (list 7 8 9 (list 1 2) (list 3 4 (list 5 6))))
(display x)
(newline)
(deep-reverse x)其实题目也算是给了提示，要模仿 E-2.18 的做法，只怪自己脑子不好使，嵌套层数一多就理不清了，后来写得越来越离谱……
E-2.28:
(define (fringe x)
(cond ((null? x) (list))
((not (pair? x)) (list x))
(else (append (fringe (car x)) (fringe (cdr x))))))
; -----------------------------------------------------------
(define x (list (list 1 2) (list 3 4)))
(fringe (list x x))E-2.29: 分不清楚 mobile 和 branch 到底是不是同一个东西，在网上找了答案（参考资料 [2]）也看不懂，最后感谢 井大侠 点拨，题目描述的其实是这么一个东东：一个物体（称为 mobile）上面插着两根棍子（称为 branch），每根棍子（branch）有两个属性，分别是 length 和 structure，而这个 structure 可能是一个权重（weight）或者是另一个物体（mobile）。
(define (make-mobile left right)
(list left right))
(define (make-branch len structure)
(list len structure))
; -----------------------------------------------------------
(define (left-branch x)
(car x))
(define (right-branch x)
(car (cdr x)))
(define (branch-length x)
(car x))
(define (branch-structure x)
(car (cdr x)))
; -----------------------------------------------------------
(define (total-weight x)
(define (mobile? m)
(pair? m))
(define (branch-weight b)
(let ((tmp (branch-structure b)))
(if (mobile? tmp)
(mobile-weight tmp)
tmp)))
(define (mobile-weight m)
(+ (branch-weight (left-branch m))
(branch-weight (right-branch m))))
(mobile-weight x))
; -----------------------------------------------------------
(define a (make-mobile (make-branch 2 3) (make-branch 2 3)))
(define b (make-mobile (make-branch 2 3) (make-branch 4 5)))
(total-weight b)E-2.30: 参考 E-2.27。
(define (square-tree t)
(define (square x) (* x x))
(cond ((null? t) (list))
((pair? (car t))
(append (list (square-tree (car t)))
(square-tree (cdr t))))
(else
(append (list (square (car t))) (square-tree (cdr t))))))
; -----------------------------------------------------
(square-tree
(list 1 (list 2 (list 3 4) 5) (list 6 7)))E-2.31:
(define (tree-map proc t)
(cond ((null? t) (list))
((pair? (car t))
(append (list (tree-map proc (car t)))
(tree-map proc (cdr t))))
(else
(append (list (proc (car t))) (tree-map proc (cdr t))))))
; ------------------------------------------------------
(define (square x) (* x x))
(define (square-tree tree) (tree-map square tree))
(square-tree
(list 1 (list 2 (list 3 4) 5) (list 6 7)))E-2.32: 找出 除第一个元素外剩下的所有元素组成的集合 的所有子集，然后再把第一个元素分别添加到这些子集中。下面是 plt-scheme 的版本，nil 要表示成“(list)”。
(define (subsets s)
(if (null? s)
(list (list))
(let ((rest (subsets (cdr s))))
(append rest (map (lambda (x)
(append (list (car s)) x))
rest)))))
; ------------------------------------------
(subsets (list 1 2 3))参考资料
[1] SICP 2.27: Reversing Nested Lists
[2] SICP 2.29: Binary Mobiles
[3] SICP 2.13 solution
[4] sicp 2.16