第三章习题 3.1 - 3.20 的解答。
E-3.1:
(define (make-accumulator value)
(define sum value)
(lambda (x)
(set! sum (+ sum x))
sum))
; ---------------------------------------------
(define A (make-accumulator 5))
(A 10)
</pre>
E-3.2:
<pre lang='scheme' line='1' src='3.2.scm'>
(define (make-momitored f)
(define sum 0)
(lambda (x)
(cond ((eq? x 'how-many-calls?) sum)
((eq? x 'reset-count) (set! sum 0))
(else
(set! sum (+ sum 1))
(f x)))))
; ---------------------------------------------
(define s (make-momitored sqrt))
(s 10)
(s 'how-many-calls?)
E-3.3: 应该把错误信息封装到一个函数里，否则当传进去的操作非法时会有额外的错误信息。
(define (make-account balance password)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (password-error amount)
(begin (display "Incorrect password\n")))
(define (method-error amount)
(map display (list "Unknown request -- MAKE-ACCOUNT: " m)))
(define (dispatch p m)
(cond ((not (eq? p password)) password-error)
((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else method-error)))
dispatch)
; ------------------------------------------------------------
(define acc (make-account 100 'secret-password))
((acc 'secret-password 'withdraw) 40)
((acc 'some-other-password 'withdraw) 40)
E-3.4:
(define (make-account balance password)
(define try-times 0)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (password-error amount)
(begin (display "Incorrect password\n")
(set! try-times (+ try-times 1))
(if (> try-times 7)
(display "call the cops\n"))))
(define (method-error amount)
(map display (list "Unknown request -- MAKE-ACCOUNT: " m)))
(define (dispatch p m)
(cond ((not (eq? p password))
password-error)
((eq? m 'withdraw)
(begin (set! try-times 0)
withdraw))
((eq? m 'deposit)
(begin (set! try-times 0)
deposit))
(else method-error)))
dispatch)
; ------------------------------------------------------------
(define acc (make-account 100 'secret-password))
((acc 'secret-password 'withdraw) 40)
((acc 'some-other-password 'withdraw) 40)
E-3.5:
(define (estimate-integral p x1 y1 x2 y2 trials)
(define (internal-p)
(p (random-in-range x1 x2) (random-in-range y1 y2)))
(monte-carlo trials internal-p))
(define (compute-pi trials experiment)
(sqrt (/ 6 (estimate-integral experiment -1 -1 1 1 trials))))
E-3.6:
(define (my-rand arg)
(define init-value 0)
(define (dispatch arg)
(cond ((eq? arg 'generate)
(+ init-value (random)))
((eq? arg 'reset)
(lambda (value)
(set! init-value value)))
(else (error "...")))))
E-3.7:
(load "3.3.scm")
(define (make-joint account password new-password)
(define (withdraw amount)
((account password 'withdraw) amount))
(define (deposit amount)
((account password 'deposit) amount))
(define (password-error amount)
(begin (display "Incorrect password\n")))
(define (method-error amount)
(map display (list "Unknown request -- MAKE-JOINT " m)))
(define (dispatch p m)
(cond ((not (eq? p new-password)) password-error)
((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else method-error)))
dispatch)
; ------------------------------------------------------------
(define acc (make-account 100 'secret-password))
(define xxx (make-joint acc 'secret-password 'new))
((acc 'secret-password 'withdraw) 40)
((xxx 'new 'withdraw) 10)
E-3.8: 加法结果只有0或2两种情况。
(define f
(let ((called 0))
(lambda (v)
(if (= v 0)
(if (= called 0)
(begin (set! called 1)
0)
1)
(if (= called 0)
(begin (set! called 1)
1)
0)))))
; ---------------------------------
(+ (f 0) (f 1))
E-3.9: 假设调用 (factorial 5)：
global +-------------------------------+
env | factorial |
+-------------------------------+
^ ^ ^ ^ ^
| | | | |
+---+ +---+ +---+ +---+ +---+
| 5 | | 4 | | 3 | | 2 | | 1 |
+---+ +---+ +---+ +---+ +---+
E-3.10: 多了一层环境变量，global 之下是 initial-amount，然后是 balance，然后才是 lambda。
E-3.11: balance 被保留下来了，也就是 global 之下是 balance，然后是各个函数。acc2 和 acc 共享代码段。图可以参考图 3.10。
E-3.12: (last-pair x) 返回的是“(b)”，然后 append! 修改了“(b)”的最后一个指针让它指向 y，因此 w 的值就成了“(a b c d)”，而因为 append! 是修改性的，因此x的值也变了。
E-3.13: 死循环。
E-3.14: 函数作用是将链表倒置。初始时 v 是“(a b c d)”，执行了 (mystery v) 之后返回倒置的链表，所以 w 的值是“(d c b a)”；但是 v 的内容被修改了，就是第一次“(set-cdr! x y)”这里修改了 v 的内容，后续修改的都是副本，与 v 无关。
E-3.15: “(set-to-wow! z1)”修改的是“(car (car z1))”，即修改“(car x)”让其指向其它内容（指向“wow”），因为 z1 的 car 和 cdr 都指向 x，因此打印的时候两个都变了；“(set-to-wow! z2)”修改的是“(car z2)”指向的内容，但是“(cdr z2)”指向的内容没变。因为 set-car! 修改的是指针指向（让指针指向其它内容），而不是指针指向的内容（例如把“a”改成“wow”）。
E-3.16: 画图太麻烦，用代码表示。
(define (count-pairs x)
(if (not (pair? x))
0
(+ (count-pairs (car x))
(count-pairs (cdr x))
1)))
; 3
(define x (cons 'a 'a))
(define z (cons x x))
(count-pairs z)
; 4
(define x (cons 'a 'a))
(define y (cons 'a x))
(define z (cons x y))
(count-pairs z)
; 7
(define x (cons 'a 'b))
(define y (cons x x))
(define z (cons y y))
(count-pairs z)
; never returns
(define x (cons 'a 'a))
(define y (cons 'a 'a))
(define z (cons 'a 'a))
(set-cdr! x y)
(set-cdr! y z)
(set-cdr! z x)
(count-pairs z)
E-3.17: 用一个列表 visited 保存遍历过的元素。每访问一个元素时先看看该元素是否已经出现在 visited 中。
; +--------------+----------------+-----+
; visited | element1 | element2 | ... |
; +--------------+----------------+-----+
; | |
; +-----------+ +-----------+
; | car | cdr | | car | cdr |
; +-----------+ +-----------+
(define (count-pairs x)
(define visited (list))
(define (exist? e)
(define (recur rest)
(if (null? rest)
#f
(if (eq? e (car rest))
#t
(recur (cdr rest)))))
(recur visited))
(define (helper l)
(if (not (pair? l))
0
(if (exist? l)
(+ (helper (car l))
(helper (cdr l)))
(begin
(set! visited (cons l visited))
(+ (helper (car l))
(helper (cdr l))
1)))))
(helper x))
; ----------------------------------------------------
(define x (cons 'a 'b))
(define y (cons x x))
(define z (cons y y))
(count-pairs z)
E-3.18: 这个和上一题有点像，都是通过查重来判断。
(define (contains-cycle? l)
(define visited (list))
(define (exist? e)
(define (recur rest)
(if (null? rest)
#f
(if (eq? e (car rest))
#t
(recur (cdr rest)))))
(recur visited))
(define (helper ll)
(if (null? ll)
#f
(if (exist? (car ll))
#t
(begin
(set! visited (cons (car ll) visited))
(helper (cdr ll))))))
(helper l))
; ----------------------------------------------------
(load "3.12.scm") ; (last-pair)
(define x '(a b c d e f g))
(set-cdr! (last-pair x) x)
(contains-cycle? x)
E-3.19: 使用两个指针，一个每次往前挪一步，另一个每次往前挪两步，如果列表有环，在若干步后这两个指针就会重合，否则第二个指针先结束。
(define (contains-cycle? l)
(define (forward-1 ll)
(if (null? ll)
ll
(cdr ll)))
(define (forward-2 ll)
(if (null? ll)
ll
(let ((next (cdr ll)))
(if (null? next)
next
(cdr next)))))
(define (helper l1 l2)
(let ((e1 (forward-1 l1))
(e2 (forward-2 l2)))
(if (null? e2)
#f
(if (eq? e1 e2)
#t
(helper e1 e2)))))
(helper l l))
; --------------------------------------------
(load "3.12.scm") ; (last-pair)
(define x '(a b c d e f g))
(set-cdr! (last-pair x) x)
(contains-cycle? x)
E-3.20: 关系如下图。定义的 x 指向函数 dispatch，此时函数 dispatch 的环境是 E1："x:1, y:2"；z 中的 x 指向 global 中的 x，所以调用 set-car! 的时候实际上是调用了 global 中的 x 的 set-car!，修改的是 E1 中 x 的值。
+----------------------------+
| x z |
+-|-----------------|--------+
| ^ | ^
| E1: | | |
| +------+ | |
| | x: 1 | | |
| | y: 2 | | |
| +------+ | |
v | v |
+-------+ | +-------+ |
| o | o --+ | o | o --+
+-|-----+ +-|-----+
| |
+---------------+
|
v
+----------+
| dispatch |
| set-car! |
| set-cdr! |
| car |
| cdr |
+----------+