3.1
(define (make-accumulator sum)
(lambda (number)
(begin (set! sum (+ sum number))
sum)))
3.2
(define (make-monitored f)
(let ((count 0))
(lambda (m)
(cond ((eq? m 'how-many-call?) count)
((eq? m 'reset-count) (begin (set! count 0)
count))
(else (begin (set! count (+ 1 count))
(f m)))))))
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 (dispatch pw m)
(if (eq? pw password)
(cond ((eq? 'withdraw m) withdraw)
((eq? 'deposit m) deposit)
(else (error "wrong request")))
(error "wrong password")))
dispatch)
3.4
(define (make-account balance password)
(let ((count 0))
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (ww m)
(display "wrong password"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (call)
(error "call the police!"))
(define (dispatch pw m)
(if (eq? pw password)
(cond ((eq? 'withdraw m) withdraw)
((eq? 'deposit m) deposit)
(else (error "wrong request")))
(begin (set! count (+ count 1))
(if (>= count 7)
(call)
ww))))
dispatch))
3.5
这里题目根本没有说清楚。。。自己敲完发现和答案还有差距，以及甚至给的random-in-range函数也要改进。。。。
引用于解题集
(define (estimate-integral p? x1 x2 y1 y2 trials)
(* 4
(monte-carlo trials
(lambda ()
(p? (random-in-range x1 x2)
(random-in-range y1 y2))))))
(define (get-pi trials)
(exact->inexact
(estimate-integral (lambda (x y)
(< (+ (square x)
(square y))
1.0))
-1.0
1.0
-1.0
1.0
trials)))
(define (random-in-range low high)
(let ((range (- high low)))
(+ low
(random (exact->inexact range)))))
3.6
(define (rand m)
(let ((x random-init))
(cond ((eq? m 'generate)
(lambda ()
(set! x (rand-update x))
x))
((eq? m 'reset)
(lambda (y)
(set! x y)
x))
(else
(error "wrong request" m)))))
3.7
(define (make-joint account old new)
(lambda (give s)
(if (eq? new give)
(account old s)
(display "wrong password"))))
3.8
(define f
(lambda (first)
(set! f (lambda (second) 0))
first))
3.9
引用于解题集
递归版本
+---------------------------------+
global env --> | |
| factorial --+ |
+--------------|------------------+
| ^
| |
| |
[*][*]----+
|
|
v
parameters: n
body: (if (= n 1)
1
(* n (factorial (- n 1))))
+---------------------------------+
global env --> | |
| |
+---------------------------------+
^
(f 6) |
|
+------+
| |
E1 -> | n: 6 |
| |
+------+
(* 6 (f 5))
+---------------------------------+
global env --> | |
| |
+---------------------------------+
^ ^
(f 6) | (f 5) |
| |
+------+ +------+
| | | |
E1 -> | n: 6 | E2-> | n: 5 |
| | | |
+------+ +------+
(* 6 (f 5)) (* 5 (f 4))
+--------------------------------------------+
global env --> | |
| |
+--------------------------------------------+
^ ^ ^
(f 6) | (f 5) | (f 4) |
| | |
+------+ +------+ +------+
| | | | | |
E1 -> | n: 6 | E2-> | n: 5 | E3 -> | n: 4 |
| | | | | |
+------+ +------+ +------+
(* 6 (f 5)) (* 5 (f 4)) (* 4 (f 3))
+----------------------------------------------------------+
global env --> | |
| |
+----------------------------------------------------------+
^ ^ ^ ^
(f 6) | (f 5) | (f 4) | (f 3) |
| | | |
+------+ +------+ +------+ +------+
| | | | | | | |
E1 -> | n: 6 | E2-> | n: 5 | E3 -> | n: 4 | E4 -> | n: 3 |
| | | | | | | |
+------+ +------+ +------+ +------+
(* 6 (f 5)) (* 5 (f 4)) (* 4 (f 3)) (* 3 (f 2))
+--------------------------------------------------------------------------+
global env --> | |
| |
+--------------------------------------------------------------------------+
^ ^ ^ ^ ^
(f 6) | (f 5) | (f 4) | (f 3) | (f 2) |
| | | | |
+------+ +------+ +------+ +------+ +------+
| | | | | | | | | |
E1 -> | n: 6 | E2-> | n: 5 | E3 -> | n: 4 | E4 -> | n: 3 | E5 -> | n: 2 |
| | | | | | | | | |
+------+ +------+ +------+ +------+ +------+
(* 6 (f 5)) (* 5 (f 4)) (* 4 (f 3)) (* 3 (f 2)) (* 2 (f 1))
+------------------------------------------------------------------------------------------+
global env --> | |
| |
+------------------------------------------------------------------------------------------+
^ ^ ^ ^ ^ ^
(f 6) | (f 5) | (f 4) | (f 3) | (f 2) | (f 1) |
| | | | | |
+------+ +------+ +------+ +------+ +------+ +------+
| | | | | | | | | | | |
E1 -> | n: 6 | E2-> | n: 5 | E3 -> | n: 4 | E4 -> | n: 3 | E5 -> | n: 2 | E6 -> | n: 1 |
| | | | | | | | | | | |
+------+ +------+ +------+ +------+ +------+ +------+
(* 6 (f 5)) (* 5 (f 4)) (* 4 (f 3)) (* 3 (f 2)) (* 2 (f 1)) 1
迭代
global env --> | |
| factorial --+ fact-iter --+ |
+--------------|-----------------------------|-------------+
| ^ | ^
| | | |
| | | |
[*][*]----+ [*][*]-----+
| |
| |
v v
parameters: n parameters: product counter max-count
body: (fact-iter 1 1 n) body: (if (> counter max-count)
product
(fact-iter (* counter product)
(+ counter 1)
max-count))
+----------+
global | |
env --> | |
| |
+----------+
^
(f 6) |
|
+-------+
| |
E1 -> | n: 6 |
| |
+-------+
(i 1 1 6)
+---------------------------+
global | |
env --> | |
| |
+---------------------------+
^ ^
(f 6) | (i 1 1 6) |
| |
+-------+ +-------+
| | | p: 1 |
E1 -> | n: 6 | E2 -> | c: 1 |
| | | m: 6 |
+-------+ +-------+
(i 1 1 6) (i 1 2 6)
...... 中间部分省略
+-----------------------------------------------------------------------------------------------------------------------------+
global | |
env --> | |
| |
+-----------------------------------------------------------------------------------------------------------------------------+
^ ^ ^ ^ ^ ^ ^ ^
(f 6) | (i 1 1 6) | (i 1 2 6) | (i 2 3 6) | (i 6 4 6) | (i 24 5 6) | (i 120 6 6) | (i 720 7 6) |
| | | | | | | |
+-------+ +-------+ +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
| | | p: 1 | | p: 1 | | p: 2 | | p: 6 | | p: 24 | | p:120 | | p:720 |
E1 -> | n: 6 | E2 -> | c: 1 | E3 -> | c: 2 | E4 -> | c: 3 | E5 -> | c: 4 | E6 -> | c: 5 | E7 -> | c: 6 | E8 -> | c: 7 |
| | | m: 6 | | m: 6 | | m: 6 | | m: 6 | | m: 6 | | m: 6 | | m: 6 |
+-------+ +-------+ +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
(i 1 1 6) (i 1 2 6) (i 2 3 6) (i 6 4 6) (i 24 5 6) (i 120 6 6) (i 720 7 6) 720
3.10
画图题，还是引用于解题集
+------------------------------------+
global env -> | |
| make-withdraw --+ |
+-------------------|----------------+
| ^
| |
v |
[*][*]----+
|
|
v
parameters: initial-amount
body: ((lambda (balance)
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
initial-amount)
执行(make-withdraw 100)
+------------------------------------+
global env -> | |
| |
+------------------------------------+
^
(make-withdraw 100) |
|
+--------------+
| |
E1 -> | initial: 100 |
| |
+--------------+
((lambda (balance)
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
initial)
因为 make-withdraw 的函数体内又是一个函数调用，所以以上的求值又引发以下的求值发生。
首先是创建又一个过程对象：
+------------------------------------+
global env -> | |
| |
+------------------------------------+
^
(make-withdraw 100) |
|
+--------------+
| |
E1 -> | initial: 100 |
| |
+--------------+
| ^
| |
| |
[*][*]-------+
|
|
v
parameters: balance
body: (lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
而这个新的过程对象会即刻被调用，继而产生又一个新环境：
+------------------------------------+
global env -> | |
| |
+------------------------------------+
^
(make-withdraw 100) |
|
+--------------+
| |
E1 -> | initial: 100 |
| |
+--------------+
^
((lambda (balance) ...) 100) |
|
+--------------+
| |
E2 -> | balance: 100 |
| |
+--------------+
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(lambda (balance) …) 的体内是另一个 lambda 表达式 (lambda (amount) …) ，因此我们要为它创建又一个过程对象：
+------------------------------------+
global env -> | |
| |
+------------------------------------+
^
(make-withdraw 100) |
|
+--------------+
| |
E1 -> | initial: 100 |
| |
+--------------+
^
((lambda (balance) ...) 100) |
|
+--------------+
| |
E2 -> | balance: 100 |
| |
+--------------+
| ^
| |
v |
[*][*]-----+
|
|
v
parameters: amount
body: (if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")
对 (make-withdraw 100) 的求值过程到此就暂告一段落了，这时，可以将符号 w1 和所得的过程对象建立约束(bundle)了：
+-------------------------------------------+
global env -> | |
| w1 |
+---|---------------------------------------+
| ^
| (make-withdraw 100) |
| |
| +--------------+
| | |
| E1 -> | initial: 100 |
| | |
| +--------------+
| ^
| ((lambda (balance) ...) 100) |
| |
| +--------------+
| | |
| E2 -> | balance: 100 |
| | |
| +--------------+
| | ^
| | |
| v |
+------------------> [*][*]-----+
|
|
v
parameters: amount
body: (if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")
使用之前求值得到的 w1 ，执行表达式 (w1 50) ，会创建以下环境：
+-------------------------------------------+
global env -> | |
| w1 |
+---|---------------------------------------+
| ^
| (make-withdraw 100) |
| |
| +--------------+
| | |
| E1 -> | initial: 100 |
| | |
| +--------------+
| ^
| ((lambda (balance) ...) 100) |
| |
| +--------------+
| | |
| E2 -> | balance: 100 |
| | |
| +--------------+
| | ^ ^
| | | | +------------+
| v | | | |
+------------------> [*][*]-----+ +------------------------------------| amount: 50 | <- E3
| | |
| +------------+
v
parameters: amount (if (>= balance amount)
body: (if (>= balance amount) (begin (set! balance (- balance amount))
(begin (set! balance (- balance amount)) balance)
balance) "Insufficient funds")
"Insufficient funds")
环境 E3 在执行过程体中的表达式之后消失， E2 的 balance 被设置为 50 ，以下是求值完毕之后的环境图：
+-------------------------------------------+
global env -> | |
| w1 |
+---|---------------------------------------+
| ^
| (make-withdraw 100) |
| |
| +--------------+
| | |
| E1 -> | initial: 100 |
| | |
| +--------------+
| ^
| ((lambda (balance) ...) 100) |
| |
| +--------------+
| | |
| E2 -> | balance: 50 |
| | |
| +--------------+
| | ^
| | |
| v |
+------------------> [*][*]-----+
|
|
v
parameters: amount
body: (if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")
最后，定义另一个 make-withdraw 实例 w2 ，它的功能性和 w1 类似，但是却保存着自己的一簇状态变量和过程对象（最明显的就是它们各自的 balance 变量）：
+-----------------------------------------------------------------------------------------+
global env -> | |
| w1 w2 |
+---|-----------------------------------------|-------------------------------------------+
| ^ | ^
| (make-withdraw 100) | | |
| | | |
| +--------------+ | +--------------+
| | | | | |
| E1 -> | initial: 100 | | E1 -> | initial: 100 |
| | | | | |
| +--------------+ | +--------------+
| ^ | ^
| ((lambda (balance) ...) 100) | | ((lambda (balance) ...) 100) |
| | | |
| +--------------+ | +--------------+
| | | | | |
| E2 -> | balance: 50 | | E2 -> | balance: 100 |
| | | | | |
| +--------------+ | +--------------+
| | ^ | | ^
| | | | | |
| v | | v |
+------------------> [*][*]-----+ +----------------------->[*][*]----+
| |
| |
v v
parameters: amount parameters: amount
body: (if (>= balance amount) body: (if (>= balance amount)
(begin (set! balance (begin (set! balance
(- balance amount)) (- balance amount))
balance) balance)
"Insufficient funds") "Insufficient funds")
3.11
还是作图题，接着引用
(define make-account
(lambda (balance)
(define withdraw
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
(define deposit
(lambda (amount)
(set! balance (+ balance amount))))
(define dispatch
(lambda (m)
(cond ((eq? m 'withdraw)
withdraw)
((eq? m 'deposit)
deposit)
(else
(error "Unknown request -- MAKE-ACCOUNT" m)))))
dispatch))
过程生成的环境模型如下：
+-------------------------------------+
global -> | |
env | make-account |
+----|--------------------------------+
| ^
| |
v |
[*][*]----+
|
|
v
parameters: balance
body: (define withdraw ...)
(define deposit ...)
(define dispatch ...)
dispatch
执行定义 (define acc (make-account 50)) ，会产生以下环境：
+----------------------------------------------------+
global -> | |
env | make-account |
+----|-----------------------------------------------+
| ^ ^
| | |
v | E1 -> +------------------+
[*][*]----+ | balance: 50 |<----------+
| | | |
| | withdraw --------------->[*][*]----> parameters: amount
v | | body: ...
parameters: balance | |<----------+
body: (define withdraw ...) | | |
(define deposit ...) | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | body: ...
(lambda (m) ...) | |<----------+
| | |
| dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
dispatch
最后，将以上求值得到的值和符号 acc 关联（前面的求值会返回 dispatch ，于是 acc 就直接指向 E1 环境中的 dispatch 过程对象）：
+----------------------------------------------------+
global -> | |
env | make-account acc |
+----|---------------|-------------------------------+
| ^ | ^
| | | |
v | | E1 -> +------------------+
[*][*]----+ | | balance: 50 |<----------+
| | | | |
| | | withdraw --------------->[*][*]----> parameters: amount
v | | | body: ...
parameters: balance | | |<----------+
body: (define withdraw ...) | | | |
(define deposit ...) | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | body: ...
(lambda (m) ...) | | |<----------+
| | | |
+---------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
求值表达式 ((acc ‘deposit) 40) ，产生以下环境：
+----------------------------------------------------+
global -> | |
env | make-account acc |
+----|---------------|-------------------------------+
| ^ | ^
| | | |
v | | E1 -> +------------------+
[*][*]----+ | | balance: 50 |<----------+
| | | | |
| | | withdraw --------------->[*][*]----> parameters: amount
v | | | body: ...
parameters: balance | | |<----------+
body: (define withdraw ...) | | | |
(define deposit ...) | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | body: ...
(lambda (m) ...) | | |<----------+
| | | |
+---------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
^
|
|
(acc 'deposit) |
|
+-------------+
| |
E2 -> | m: 'deposit |
| |
+-------------+
(cond ((eq? m 'withdraw)
withdraw)
((eq? m 'deposit)
deposit)
(else
(error "..." m)))
(acc ‘deposit) 将返回过程 deposit ，这个 deposit 又作为新的过程操作符，被参数 40 应用，并且 E2 在求值之后消失：
+----------------------------------------------------+
global -> | |
env | make-account acc |
+----|---------------|-------------------------------+
| ^ | ^
| | | |
v | | E1 -> +------------------+
[*][*]----+ | | balance: 50 |<----------+
| | | | |
| | | withdraw --------------->[*][*]----> parameters: amount
v | | | body: ...
parameters: balance | | |<----------+
body: (define withdraw ...) | | | |
(define deposit ...) | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | body: ...
(lambda (m) ...) | | |<----------+
| | | |
+---------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
^
|
|
(deposit 40) |
|
+------------+
| |
E3 -> | amount: 40 |
| |
+------------+
(set! balance (+ balance amount))
表达式在 E3 环境中求值，沿着外围环境指针查找并修改 balance 的值，求值完毕之后， E3 消失：
+----------------------------------------------------+
global -> | |
env | make-account acc |
+----|---------------|-------------------------------+
| ^ | ^
| | | |
v | | E1 -> +------------------+
[*][*]----+ | | balance: 90 |<----------+
| | | | |
| | | withdraw --------------->[*][*]----> parameters: amount
v | | | body: ...
parameters: balance | | |<----------+
body: (define withdraw ...) | | | |
(define deposit ...) | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | body: ...
(lambda (m) ...) | | |<----------+
| | | |
+---------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
以上就是求值之后得到的环境，注意 balance 的值已经被修改为 90 了。
然后，进行第二次求值 ((acc ‘withdraw) 60) ，得出以下环境：
+----------------------------------------------------+
global -> | |
env | make-account acc |
+----|---------------|-------------------------------+
| ^ | ^
| | | |
v | | E1 -> +------------------+
[*][*]----+ | | balance: 90 |<----------+
| | | | |
| | | withdraw --------------->[*][*]----> parameters: amount
v | | | body: ...
parameters: balance | | |<----------+
body: (define withdraw ...) | | | |
(define deposit ...) | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | body: ...
(lambda (m) ...) | | |<----------+
| | | |
+---------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
^
|
|
+--------------+
| |
E4 -> | m: 'withdraw |
| |
+--------------+
(cond ((eq? m 'withdraw)
withdraw)
((eq? m 'deposit)
deposit)
(else
(error "...")))
接着求值表达式 (withdraw 60) ：
+----------------------------------------------------+
global -> | |
env | make-account acc |
+----|---------------|-------------------------------+
| ^ | ^
| | | |
v | | E1 -> +------------------+
[*][*]----+ | | balance: 90 |<----------+
| | | | |
| | | withdraw --------------->[*][*]----> parameters: amount
v | | | body: ...
parameters: balance | | |<----------+
body: (define withdraw ...) | | | |
(define deposit ...) | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | body: ...
(lambda (m) ...) | | |<----------+
| | | |
+---------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
^
|
|
+------------+
| |
E5 -> | amount: 60 |
| |
+------------+
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"...")
以下是求值完毕之后的环境：
+----------------------------------------------------+
global -> | |
env | make-account acc |
+----|---------------|-------------------------------+
| ^ | ^
| | | |
v | | E1 -> +------------------+
[*][*]----+ | | balance: 30 |<----------+
| | | | |
| | | withdraw --------------->[*][*]----> parameters: amount
v | | | body: ...
parameters: balance | | |<----------+
body: (define withdraw ...) | | | |
(define deposit ...) | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | body: ...
(lambda (m) ...) | | |<----------+
| | | |
+---------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
注意 balance 已经被修改为 30 了。
最后，如果我们进行定义 (define acc2 (make-account 100)) ，那么会产生另一个 make-account 过程对象，这个过程并不和 acc 共享任何的过程或者状态变量，具体的环境定义如下：
+---------------------------------------------------------------+
global -> | |
env | make-account acc2 acc |
+----|-----------------|--------|-------------------------------+
| ^ | | ^
| | | | |
v | | | E1 -> +------------------+
[*][*]----+ | | | balance: 30 |<----------+
| | | | | |
| | | | withdraw --------------->[*][*]----> parameters: amount
v | | | | body: ...
parameters: balance | | | |<----------+
body: (define withdraw ...) | | | | |
(define deposit ...) | | | deposit ---------------->[*][*]----> parameters: amount
(define dispatch ...) | | | | body: ...
(lambda (m) ...) | | | |<----------+
| | | | |
| +---------->dispatch --------------->[*][*]----> parameters: m
| | | body: ...
| +------------------+
|
|
|
| E6 -> +------------------+
| | balance: 100 |<----------+
| | | |
| | withdraw --------------->[*][*]----> parameters: amount
| | | body: ...
| | |<----------+
| | | |
| | deposit ---------------->[*][*]----> parameters: amount
| | | body: ...
| | |<----------+
| | | |
+--------->dispatch --------------->[*][*]----> parameters: m
| | body: ...
+------------------+
3.12
以后只要遇到画图题都会参考解题集
x --> [*]----> [*]----> '()
| |
v v
'a 'b
y --> [*]----> [*]----> '()
| |
v v
'c 'd
z --> [*]---->[*]---->[*]---->[*]----> '()
| | | |
v v v v
'a 'b 'c 'd
w------+
|
|
v
x --> [*]----> [*]----+
| | |
v v |
'a 'b |
|
+--------------+
|
v
y --> [*]----> [*]----> '()
| |
v v
'c 'd
z --> [*]---->[*]---->[*]---->[*]----> '()
| | | |
v v v v
'a 'b 'c 'd
3.13
+-----------------------+
| |
v |
z ----> [*]----> [*]----> [*]----+
| | |
v v v
'a 'b 'c
3.14
实际上， mystery 就是一个修改版的 reverse 函数：
1 ]=> (define v (list 'a 'b 'c))
;Value: v
1 ]=> (define w (mystery v))
;Value: w
1 ]=> w
;Value 11: (c b a)
1 ]=> v
;Value 12: (a)
以下是 v 执行 mystery 之前的盒子图形：
v --> [*]----> [*]----> [*]----> '()
| | |
v v v
'a 'b 'c
以下是执行 (mystery v) 的过程：
(mystery v)
(mystery (list 'a 'b 'c))
(loop (list 'a 'b 'c) '())
(let ((temp (list 'b 'c)))
(set-cdr! (list 'a 'b 'c) '())
(loop (list 'b 'c) (list a)))
(loop (list 'b 'c) (list a))
(let ((temp (list 'c)))
(set-cdr! (list 'b 'c) (list a))
(loop (list 'c) (list 'b 'a)))
(loop (list 'c) (list 'b 'a))
(let ((temp '()))
(set-cdr! (list 'c) (list 'b 'a))
(loop '() (list 'c 'b 'a)))
(loop '() (list 'c 'b 'a))
(list 'c 'b 'a)
以下是执行 (define w (mystery v)) 之后 w 和 v 的盒子图形：
v------------------------+
|
v
w --> [*]----> [*]----> [*]----> '()
| | |
v v v
'c 'b 'a
3.15
以下是 z1 执行 set-to-wow! 之后的盒子图形(执行之前的盒子图形在书本 177 页)：
z1 --> [*][*]
| |
v v
x --> [*][*]--> [*][/]
| |
v v
'wow! 'wow!
接着进行 z2 的测试：
1 ]=> (define z2 (cons (list 'a 'b) (list 'a 'b)))
;Value: z2
1 ]=> z2
;Value 12: ((a b) a b)
1 ]=> (set-to-wow! z2)
;Value 12: ((wow! b) a b)
以下是执行 set-to-wow! 之后的 z2 的盒子图形：
z2 --> [*][*]--> [*][*]--> [*][/]
| | |
| v v
| 'a 'b
| ^
| |
+------> [*][*]--> [*][/]
|
v
'wow!
3.16
事实上，我们可以将序对之间的连接看作是有向图，比如 (cons 1 (cons 2 ‘())) 可以表示为：
*----> *---->
| |
v v
1 2
而这个 count-pairs 的问题是，当图中的点（也即是序对）有多于一个入度的时候，它的计算方式就不对了。
以下是其中一个可能的情况：
*------+
| |
| v
+----> *---->
|
v
1
题目要求我们构造一个能让 count-pairs 返回几个不同结果的序对组合，其实就是要求我们构成一个个图，其中需要遍历 N 步才能走到一个未连接到任何点的边（也即是 ‘() ）。
不返回结果的组合可以用一个环来解决（会让程序直接崩溃）：
1 ]=> (define crycle (cons 1 (cons 2 (cons 3 '()))))
;Value: crycle
1 ]=> (set-cdr! (last-pair crycle) crycle)
;Unspecified return value
1 ]=> (count-pairs crycle)
;Aborting!: maximum recursion depth exceeded
以下是 crycle 的盒子图形：
+--------------+
| |
v |
crycle --> [*]---> [*]-----+
| |
v v
1 2
返回结果 3 的组合也很容易做出来：
1 ]=> (define three (cons (cons 1 '()) (cons 2 '())))
;Value: three
1 ]=> three
;Value 12: ((1) 2)
1 ]=> (count-pairs three)
;Value: 3
以下是 three 的盒子图形：
three --> [*]---> [*]---> [/]
| |
| v
| 2
v
[*]---> [/]
|
v
1
返回结果 4 的组合需要将同一个序对的两个指针分别指向一个长度为 2 的列表的首个元素和第二个元素：
1 ]=> (define four (cons two (cdr two)))
;Value: four
1 ]=> four
;Value 15: ((1 2) 2)
1 ]=> (count-pairs four)
;Value: 4
以下是 (cons two (cdr two)) 的盒子图形：
[*]------+
| |
| |
v v
two --> [*]---> [*]---> [/]
| |
v v
1 2
最后，是返回 7 的组合：
1 ]=> (define one (list 1))
;Value: one
1 ]=> (define three (cons one one))
;Value: three
1 ]=> (define seven (cons three three))
;Value: seven
1 ]=> (count-pairs seven)
;Value: 7
以下是相应的盒子图形：
seven --> [*]
||
||
vv
three --> [*]
||
||
vv
one --> [*]---> [/]
|
v
1
最后要说的是，构造的组合并不是唯一的，比如说，以下组合也可以让 count-pairs 返回 4 ：
1 ]=> (define x (cons 1 '()))
;Value: x
1 ]=> (define y (cons x '()))
;Value: y
1 ]=> (define z (cons y x))
;Value: z
1 ]=> (count-pairs z)
;Value: 4
1 ]=> z
;Value 12: (((1)) 1)
它的盒子图形是：
z --> [*]---------------+
| |
| |
v |
y --> [*]---> [/] |
| |
| |
+---------------+|
||
||
vv
x --> [*]---> [/]
|
v
1
3.17
(define (count-pairs x)
(define (leq? x y) ; is exist in list member?
(cond ((null? y) #f)
((eq? (car y) x) #t)
(else (leq? x (cdr y)))))
(define (iter x y)
(if (and (pair? x) (not (leq? x y)))
(iter (car x) (iter (cdr x) (cons x y)))
y))
(length (iter x '())))
3.18
看网上的快慢法做的，没想到是3.19的答案。。。刚开始犯的毛病就是想去修改函数题内let变量的值，但这不是一个很好的操作，应该是写一个迭代进行检测
参考了解题集
（define (loop? lst)
(let ((identity (cons '() '())))
(define (iter remain-list)
(cond ((null? remain-list)
#f)
((eq? identity (car remain-list))
#t)
(else
(set-car! remain-list identity)
(iter (cdr remain-list)))))
(iter lst)))
3.19
(define (f-cycle w)
(define (iter x y)
(let ((x1 (cdr x)) (x2 (cdr (cdr y))))
(cond ((or (null? x2) (null? x1)) #f)
((eq? x1 x2) #t)
(else (iter x1 x2)))))
(iter w w))
3.20
以下是执行定义 (define x (cons 1 2)) 之后的环境图：
+------------------------------+
global -> | |
env | x |
+--|---------------------------+
| ^
| |
| +----------+
| E1 -> | x: 1 |
| | y: 2 |
| | |
| | set-x! -----> ...
| | set-y! -----> ...
+--------->dispatch ---> parameters: m
| | body: (cond ((eq? m 'car) 'car)
+----------+ ((eq? m 'cdr) 'cdr)
((eq? m 'set-car!) 'set-car!)
((eq? m 'set-cdr!) 'set-cdr!)
(else
(error "..." m)))
以下是执行定义 (define z (cons x x)) 之后的环境图：
+-------------------------------------------------------+
global -> | |
env | z x |
+--|---------------------------|------------------------+
| ^ | ^
| | | |
| | | +----------+
| | | | x: 1 |
| | | | y: 2 |
| | | | |
| | | | set-x! -----> ...
| | | | set-y! -----> ...
| | +------->dispatch ---> parameters: m
| | | ^ ^ | body: ...
| | +--|-|-----+
| +----------+ | |
| E2 -> | x: ------------------------+ |
| | y: --------------------------+
| | |
| | set-x! -----> ...
| | set-y! -----> ...
+--------->dispatch ---> parameters: m
| | body: (cond ((eq? m 'car) 'car)
+----------+ ((eq? m 'cdr) 'cdr)
((eq? m 'set-car!) 'set-car!)
((eq? m 'set-cdr!) 'set-cdr!)
(else
(error "..." m)))
执行表达式 (set-car! (cdr z) 17) 有以下两个步骤：
执行 (cdr z) ，返回 x
执行 (set-car! x 17) ，引发表达式 ((x ‘set-car!) 17) 的执行,然后又引发 (set-x! 17) 的执行
最终， x 的 car 部分的值被设置为 17 。
以下是相应的环境图：
+-------------------------------------------------------+
global -> | |
env | z x |
+--|---------------------------|------------------------+
| ^ | ^
| | | |
| | | +----------+
| | | | x: 17 |
| | | | y: 2 |
| | | | |
| | | | set-x! -----> ...
| | | | set-y! -----> ...
| | +------->dispatch ---> parameters: m
| | | ^ ^ | body: ...
| | +--|-|-----+
| +----------+ | |
| E2 -> | x: ------------------------+ |
| | y: --------------------------+
| | |
| | set-x! -----> ...
| | set-y! -----> ...
+--------->dispatch ---> parameters: m
| | body: (cond ((eq? m 'car) 'car)
+----------+ ((eq? m 'cdr) 'cdr)
((eq? m 'set-car!) 'set-car!)
((eq? m 'set-cdr!) 'set-cdr!)
(else
(error "..." m)))
整个求值过程如下：
1 ]=> (load "20-pair.scm")
;Loading "20-pair.scm"... done
;Value: set-cdr!
1 ]=> (define x (cons 1 2))
;Value: x
1 ]=> (define z (cons x x))
;Value: z
1 ]=> (set-car! (cdr z) 17)
;Value: 1 ; 使用 set! 设置变量时会返回变量的旧值
1 ]=> (car x)
;Value: 17
3.21
queue的cdr项应该是他最后插入的元素，所以只要输出car项即可
(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))
(define (front-queue queue)
(if (empty-queue? queue)
(error "FRONT called with an empty queue" queue)
(car (front-ptr queue))))
(define (insert-queue! queue item)
(let ((new-pair (cons item '())))
(cond ((empty-queue? queue)
(set-front-ptr! queue new-pair)
(set-rear-ptr! queue new-pair)
queue)
(else
(set-cdr! (rear-ptr queue) new-pair)
(set-rear-ptr! queue new-pair)
queue))))
(define (delete-queue! queue)
(cond ((empty-queue? queue)
(error "DELETE! called with an empty queue" queue))
(else
(set-front-ptr! queue (cdr (front-ptr queue)))
queue)))
(define (print-queue queue)
(car queue))
(define q1 (make-queue))
(insert-queue! q1 'a)
(insert-queue! q1 'b)
(delete-queue! q1)
(delete-queue! q1)
(insert-queue! q1 'b)
(print-queue q1)
3.22
(define (make-queue)
(let ((front-ptr '())
(rear-ptr '()))
(define (empty-queue?) (null? front-ptr))
(define (insert-queue! item)
(cond((empty-queue?)
(let ((init-list (list item)))
(set! front-ptr init-list)
(set! rear-ptr init-list)
front-ptr))
(else
(let ((new-item (list item)))
(set-cdr! rear-ptr new-item)
(set! rear-ptr new-item)
front-ptr))))
(define (delete-queue!)
(cond ((empty-queue?)
(error "DELETE! called with an empty queue" front-ptr))
(else
(set! front-ptr (cdr front-ptr))
front-ptr)))
(define (dispatch m)
(cond ((eq? m 'empty-queue?) empty-queue?)
((eq? m 'insert-queue!) insert-queue!)
((eq? m 'delete-queue!) delete-queue!)
(else
(error "Undefined operation -- queue" m))))
dispatch))
3.23
(define (front-ptr deque) (car deque))
(define (rear-ptr deque) (cdr deque))
(define (set-front-ptr! deque item) (set-car! deque item))
(define (set-rear-ptr! deque item) (set-cdr! deque item))
(define (empty-deque? deque) (null? (front-ptr deque)))
(define (make-deque) (cons '() '()))
(define (front-deque deque)
(if (empty-deque? deque)
(error "FRONT called with an empty deque" deque)
(car (front-ptr deque))))
(define (rear-deque deque)
(if (empty-deque? deque)
(error "REAR-DEQUE called with an empty deque" deque)
(car (rear-ptr deque))))
(define (rear-insert-deque! deque item)
(let ((new-pair (cons item '())))
(cond ((empty-deque? deque)
(set-front-ptr! deque new-pair)
(set-rear-ptr! deque new-pair)
deque)
(else
(set-cdr! (rear-ptr deque) new-pair)
(set-rear-ptr! deque new-pair)
deque))))
(define (front-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty queue" deque))
(else
(set-front-ptr! deque (cdr (front-ptr deque)))
deque)))
(define (front-insert-deque! deque item)
(cond ((empty-deque? deque)
(rear-insert-deque! deque item)
deque)
(else
(set-front-ptr! deque (cons item (front-ptr deque)))
deque)))
这里值得注意的是我们的rear-delete-deque如果还按之前的数据结构来说无法常数访问了（因为rear-ptr不能回溯到前一个，所以只能从front-ptr遍历访问到下一个），所以为了在o1内完成，我们必须采取双向链表的形式，存储信息。
(define (front-ptr deque) (car deque))
(define (rear-ptr deque) (cdr deque))
(define (set-front-ptr! deque item) (set-car! deque item))
(define (set-rear-ptr! deque item) (set-cdr! deque item))
(define (empty-deque? deque) (null? (front-ptr deque)))
(define (make-deque) (cons '() '()))
(define (front-deque deque)
(if (empty-deque? deque)
(error "FRONT called with an empty deque" deque)
(front-ptr deque)))
(define (rear-deque deque)
(if (empty-deque? deque)
(error "REAR-DEQUE called with an empty deque" deque)
(rear-ptr deque)))
(define (front-insert-deque! deque item)
(let ((data-pair (cons item '())))
(if (empty-deque? deque)
(let ((ptr-pair (cons data-pair '())))
(set-front-ptr! deque ptr-pair)
(set-rear-ptr! deque ptr-pair)
deque)
(let ((first-data-pair (car (front-deque deque)))
(ptr-pair (cons data-pair (front-deque deque))))
(set-cdr! first-data-pair ptr-pair)
(set-front-ptr! deque ptr-pair)
deque))))
(define (rear-insert-deque! deque item)
(let ((new-pair (cons item '())))
(cond ((empty-deque? deque)
(set-front-ptr! deque new-pair)
(set-rear-ptr! deque new-pair)
deque)
(else
(set-cdr! (rear-ptr deque) new-pair)
(set-rear-ptr! deque new-pair)
deque))))
(define (front-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty queue" deque))
(else
(let ((first-ptr (front-deque deque)))
(let ((second-ptr (cdr first-ptr)))
(if (null? second-ptr)
(begin
(set-front-ptr! deque '())
deque)
(begin
(set-cdr! (car second-ptr) '())
(set-front-ptr! deque second-ptr)
deque)))))))
(define (rear-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty queue" deque))
(else
(let ((last-ptr (rear-deque deque)))
(let ((second-ptr (car last-ptr)))
(if (null? second-ptr)
(begin
(set-rear-ptr! deque '())
deque)
(begin
(set-cdr! (cdr second-ptr) '())
(set-rear-ptr! deque second-ptr)
deque)))))))
(define (print-deque deque)
(define (iter l)
(if (null? l)
'()
(cons (caar l) (iter (cdr l)))))
(iter (front-ptr deque)))
参考自https://github.com/jiacai2050/sicp/blob/master/exercises/03/3.23.md
只要我们能访问到尾指针的前一个元素，我们就能进行o1时间复杂度的删除操作。
3.24
先敲书里的代码做准备
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
就是用提供的判断取代先前的eq?
(define (make-table same-key?)
(let ((local-table (list '*table*)))
(define (assoc key records)
(cond ((null? records) false)
((same-key? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
3.25
(define (lookup key-list table)
(if (list? key-list)
(let ((subtable (assoc (car key-list) (cdr table))))
(cond
((and subtable (null? (cdr key-list)))
(cdr subtable))
((and subtable (not (null? (cdr key-list))))
(lookup (cdr key-list) (cdr subtable)))
(else
false)))
(lookup (list key-list) table)))
(define (insert! key-list value table)
(if (list? key-list)
(let ((record (assoc (car key-list) (cdr table))))
(cond
((and record (null? (cdr key-list)))
(set-cdr! record value)
table)
((and record (cdr key-list))
(insert! (cdr key-list) value record)
table)
((and (not record) (not (null?(cdr key-list))))
(set-cdr! table
(cons (insert! (cdr key-list) value (make-table (car key-list)))
(cdr table)))
table)
((and (not record) (null? (cdr key-list)))
(set-cdr! table
(cons (cons (car key-list) value)
(cdr table)))
table)))
(insert! (list key-list) value table)))
(define (make-table . table-name)
(if (null? table-name)
(list '*table*)
table-name))
我的难点在怎么判断是最初时候对table进行添加，解题集的思路很好，修改了make-table的定义使得insert!的操作好写很多。
3.26
不知道怎么进行字典树排序
自己先写了个数值排序的最后照着习题解推广成多类型的键值
(define (make-tree key value left right)
(list key value left right))
(define (tree-key tree)
(car tree))
(define (tree-value tree)
(cadr tree))
(define (tree-left tree)
(caddr tree))
(define (tree-right tree)
(cadddr tree))
(define (tree-empty? tree)
(null? tree))
(define (tree-set-key! key tree)
(set-car! tree key))
(define (tree-set-value! value tree)
(set-car! (cdr tree) value))
(define (tree-set-left! left tree)
(set-car! (cddr tree) left))
(define (tree-set-right! right tree)
(set-car! (cdddr tree) right))
(define (tree-insert! tree key value p?)
(if (tree-empty? tree)
(make-tree key value '() '())
(cond ((= 0 (p? key (tree-key tree)))
(tree-set-value! value tree)
tree)
((= 1 (p? key (tree-key tree)))
(tree-set-right!
(tree-insert! (tree-right tree)
key
value
p?)tree)
tree)
((= -1 (p? key (tree-key)))
(tree-set-left!
(tree-insert! (tree-left tree)
key
value
p?)tree)
tree))))
(define (tree-search key tree p?)
(if (tree-empty? tree)
'()
(cond ((= 0 (p? key (tree-key tree)))
tree)
((= 1 (p? key (tree-key tree)))
(tree-search key
(tree-right tree)
p?))
((= -1 (p? key (tree-key)))
(tree-search key
(tree-left tree)
p?))
)))
(define (compare-string x y)
(cond ((string=? x y)
0)
((string>? x y)
1)
((string<? x y)
-1)))
(define (compare-symbol x y)
(compare-string (symbol->string x)
(symbol->string y)))
(define (compare-number x y)
(cond ((= x y)
0)
((> x y)
1)
((< x y)
-1)))
(define (make-table compare)
(let ((tree '()))
(define (empty?)
(tree-empty? tree))
(define (lookup key)
(let ((result (tree-search key tree compare)))
(if (null? result)
#f
(tree-value result))))
(define (insert! key value)
(set! tree (tree-insert! tree key value compare))'ok)
(define (dispatch m)
(cond ((eq? m 'insert!) insert!)
((eq? m 'lookup) lookup)
((eq? m 'empty?) (empty?))
(else (error "wrong request" m))))
dispatch))
3.27
为了简化分析，先将 memoize 转换成一系列表达式：
(define memoize
(lambda (f)
((lambda (table)
(lambda (x)
((lambda (previously-computed-result)
(or previously-computed-result
((lambda (result)
(insert! x result table)
result)
(f x))))
(lookup x table))))
(make-table))))
memo-fib 已经是 lambda 表达式了，所以不用转换：
(define memo-fib
(memoize (lambda (n)
(cond ((= n 0)
0)
((= n 1)
1)
(else
(+ (memo-fib (- n 1))
(memo-fib (- n 2))))))))
当表达式 (memo-fib 3) 执行时，它首先展开表达式 (memoize (lambda (n) …)) ，调用以下执行序列：
(memo-fib 3) ; 展开 memoize
((lambda (f) ; 展开参数 f
((lambda (table)
(lambda (x)
((lambda (previously-computed-result)
(or previously-computed-result
((lambda (result)
(insert! x result table)
result)
(f x))))
(lookup x table))))
(make-table)))
(lambda (n)
(cond ((= n 0)
0)
((= n 1)
1)
(else
(+ (memo-fib (- n 1))
(memo-fib (- n 2)))))))
((lambda (table) ; 创建表，展开参数 table
(lambda (x)
((lambda (previously-computed-result)
(or previously-computed-result
((lambda (result)
(insert! x result table)
result)
((lambda (n)
(cond ((= n 0)
0)
((= n 1)
1)
(else
(+ (memo-fib (- n 1))
(memo-fib (- n 2))))))
x))))
(lookup x table))))
(make-table))
(lambda (x) ; (memoize (lambda (n) ...)) 展开完毕
((lambda (previously-computed-result)
(or previously-computed-result
((lambda (result)
(insert! x result table)
result)
((lambda (n)
(cond ((= n 0)
0)
((= n 1)
1)
(else
(+ (memo-fib (- n 1))
(memo-fib (- n 2))))))
x))))
(lookup x table)))
以上表达式创建这样一个环境：
+-----------------------------------------------------------------------------------------------------+
| |
global -> | memo-fib |
env | | |
+--|--------------------------------------------------------------------------------------------------+
| ^
| |
| (lambda (f) ...) |
| |
| +-----+
| | |
| | |<---------+
| | | |
| | f ------->[*][*]
| | | parameters: n
| +-----+ body: (cond ((= n 0)
| ^ 0)
| | ((= n 1)
| | 1)
| (lambda (table) | (else
| ...) | (+ (memo-fib (- n 1))
| | (memo-fib (- n 2)))))
| |
| +-------+
| | |
| | |<------------------------------------------+
| | | |
| | table -----------------------------------+ +------------------------------+
| | | | | |
| +-------+ | | local-table: (list '*table*) |
| | ^ | | |
| | | | | assoc |
+--------------->[*][*] | | lookup |
| | | insert! |
| +----->dispatch |
| | |
| +------------------------------+
v
parameters: x
body: ((lambda (previously-computed-result)
(or previously-computed-result
((lambda (result)
(insert! x result table)
result)
(f x))))
(lookup x table))
将参数 3 应用到表达式 (lambda (x) ...) ，将创建这样一个环境：
+-----------------------------------------------------------------------------------------------------+
| |
global -> | memo-fib |
env | | |
+--|--------------------------------------------------------------------------------------------------+
| ^
| |
| (lambda (f) ...) |
| |
| +-----+
| | |
| | |<---------+
| | | |
| | f ------->[*][*]
| | | parameters: n
| +-----+ body: (cond ((= n 0)
| ^ 0)
| | ((= n 1)
| | 1)
| (lambda (table) | (else
| ...) | (+ (memo-fib (- n 1))
| | (memo-fib (- n 2)))))
| |
| +-------+
| | |
| | |<------------------------------------------+
|+--------------| | |
vv | table -----------------------------------+ +------------------------------+
[*][*]--------->| | | | |
| +-------+ | | local-table: (list '*table*) |
v ^ | | |
parameters: x | | | assoc |
body: ... | | | lookup |
| | | insert! |
| +----->dispatch |
(lambda (x) | | |
...) | +------------------------------+
|
+------+
| |
| x: 3 |
| |
+------+
^
|
(lambda |
(previously-computed-result) |
...) |
|
|
+----------------------------------------------+
| |
| previously-computed-result: (lookup x table) |
| |
+----------------------------------------------+
(or previously-computed-result
((lambda (result)
(insert! x result table)
result)
(f x)))
当 (memo-fib 3) 计算完毕之后，环境变成了这样：
+--------------------+
| |
global -> | memo-fib |
env | |
+--------------------+
^
|
(lambda (f) ...) |
|
+-----+
| |
| |<---------+
| | |
| f ------->[*][*]
| | parameters: n
+-----+ body: (cond ((= n 0)
^ 0)
| ((= n 1)
| 1)
(lambda (table) | (else
...) | (+ (memo-fib (- n 1))
| (memo-fib (- n 2)))))
|
+-------+
| |
| |<------------------------------------------+
| | |
| table -----------------------------------+ +---------------------------------------------------------------+
| | | | |
+-------+ | | local-table: (list '*table* (cons 3 2) (cons 2 1) (cons 1 1)) |
| ^ | | |
| | | | assoc |
[*][*] | | lookup |
| | | insert! |
| +----->dispatch |
| | |
| +---------------------------------------------------------------+
v
parameters: x
body: ((lambda (previously-computed-result)
(or previously-computed-result
((lambda (result)
(insert! x result table)
result)
(f x))))
(lookup x table))
注意指向 table 的子环境中的 local-table 的值，在计算开始之前，它除了表头之外没有其他元素，现在它保存了三组斐波那契数的计算结果。
这也是 (memo-fib 3) 可以在线性时间内完成计算的原因： memo-fib 每次计算出一个斐波那契数 (memo-fib i) ，就将 i 和 (memo-fib i) 组成序对，并将这个序对加入进 local-table 里面；如果下次再遇到同样的 i ，那么 memo-fib 就直接返回 local-table 中对应的斐波那契数，从而消除了重复计算。
题目的另一个问题是，如果简单地将 memo-fib 定义为 (memoize fib) ，那么记忆法还能工作吗？
可以在解释器中尝试运行这个新的定义：
(define (fib n)
(cond ((= n 0)
0)
((= n 1)
1)
(else
(+ (fib (- n 1))
(fib (- n 2))))))
(define memo-fib (memoize fib))
测试：
1 ]=> (load "27-another-memo-fib.scm")
;Value: memo-fib
1 ]=> (memo-fib 3)
;Value: 2
需要注意的是，虽然这个新的 memo-fib 也可以正常运行，但它的执行效率并没有太大的提高：因为每次调用 (memo-fib i) 的时候，这个 memo-fib 只保存 i 和 (memo-fib i) 的值，但是其他的斐波那契计算结果，这个 memo-fib 并不保存。
比如说，当调用 (memo-fib 3) 时， (memo-fib 3) 的结果会被保存进表里面，但是 (memo-fib 2) 和 (memo-fib 1) 的计算结果却不会被保存。
因此，这个版本的 memo-fib 仍然会有重复计算，它的复杂度仍然是指数级的。
3.28
(define (or-gate a1 a2 output)
(define (or-action-procedure)
(let ((new-value
(logical-or (get-signal a1) (get-signal a2))))
(after-delay or-gate-delay
(lambda ()
(set-sighal! output new-value)))))
(add-action! a1 or-action-procedure)
(add-action! a2 or-action-procedure)
'ok)
(define (logical-or a1 a2)
(if (and (= a1 0) (= a2 0))
0
1))
3.29
(define (or-gate a1 a2 output)
(let ((op1 (make-wire)) (op2 (make-wire)) (op3 (make-wire)))
(inverter a1 op1)
(inverter a2 op2)
(and-gate op1 op2 op3)
(inverter op3 output))
'ok)
3.30
(define (ripple-carry-adder A-list B-list S-list C)
(define (iter A B S C-in)
(if (and (null? A) (null? B) (null? S))
'ok
(let ((C-out (make-wire)))
(set-signal! temp-C C-in)
(full-adder (car A) (car B) temp-C (car S) C)
(iter (cdr A) (cdr B) (cdr S) (get-signal C)))))
(iter A-list B-list S-list (get-signal C)))
延迟的概念不是很懂
ripple-carry-adder-delay 的值为三个 or-gate-delay 、两个 inveter-delay 和四个 and-gate-delay 之和
3.31
引用于解题集
为了让问题简化，让我们来追踪一个 inverter 的执行过程(道理是一样的，但是 half-adder 的追踪要复杂很多)。
假设现在有两条线路，分别是 input 和 output ，求值 (inverter input output) 会执行这样一个展开序列：
(inverter input output)
(define (invert-input)
(let ((new-value (logical-not (get-signal input))))
(after-delay invert-delay
(lambda ()
(set-signal! output new-value)))))
注意，前面只是定义 invert-input 过程，但是还没有执行它，接下来，当 add-action! 执行时，以下的执行过程发生：
(add-action! input invert-input)
(((eq? m 'add-action!) accept-action-procedure!) invert-input)
(accept-action-procedure! invert-input)
(set! action-procedures
(cons proc action-procedures) ; 将 invert-input 加入线路的 action-procedures 中
(invert-input)) ; (proc)
可以看到，在上面展开的最后一步， invert-input 才会被执行，它的执行过程展开如下：
(after-delay invert-delay
(lambda ()
(set-signal! output new-value)))
(add-to-agenda! (+ delay (current-time the-agenda))
action
the-agenda)
after-delay 会调用 add-to-agenda! ，将指定的动作添加到模拟器的待处理列表中，当调用 (propagate) 时，这个指定的动作会被执行。
如果我们按照题目所讲，将 accept-action-procedure! 的 (proc) 这一行去掉的话，那么相应的动作过程就不会被添加到待处理列表。
以这个 inveter 作例子，如果 accept-action-procedure! 缺少 (proc) 这一步，那么 (invert-input) 就不会被执行，反门的动作也不会被添加到模拟器的处理列表里；如果这时候运行 (propagate) 的话，那么什么东西也不会发生，因为待处理列表里面空无一物。
3.32
假设现在有线路 a1 、 a2 和 output ，分别是两条输入线路和一条输出线路，值分别是 0 、 1 和 0 。
如果模拟器使用先进先出的方式处理事件，当输入从 0,1 改变到 1,0 时， a1 的事件先被触发，它取出 a1 和 a2 的值 1,1 ，并将 output 的值设置为 1 ；接着， a2 的事件被触发，它取出 a1 和 a2 的值 1,0 ，并将 output 的值设置为 0 。
如果模拟器使用后进先出的方式处理事件，当输入从 0,1 改变到 1,0 时， a2 的事件先被处理，它取出 a1 和 a2 的值 0,0 ，并将 output 设置为 0 ；接着， a1 的事件被触发，它取出 a1 和 a2 的值 1,0 ，并将 output 的值设置为 0 。
可以看到，两种不同的事件处理方式给出的最终结果是一样的，但是产生的中间状态不同。
3.33
(define (average a b c)
(let ((d (make-connector))
(e (make-connector)))
(adder a b d)
(constant (/ 1 2) e)
(multiplier d e c)
'ok))
3.34
我们设前一个a为a1，后一个a为a2，乘法约束是知二求另外的一，但a1和a2值相等即我们都不知道时就无法求解，（因为没有规定过这种情况如何求解）
3.35
(define (squarer a b)
(define (process-new-value)
(if (has-value? b)
(if (< (get-value b) 0)
(error "square less than 0 -- SQUARER" (get-value b))
(set-value! a (sqrt (get-value b))
me))
(if (has-value? a)
(set-value! b (* (get-value a) (get-value a)) me)
(error "a or b doesnot have value"))))
(define (process-forget-value)
(forget-value! b me)
(forget-value! a me));不必再调用 (process-new-value),否则就会出错
(define (me request)
(cond ((eq? request 'I-have-a-value)
(process-new-value))
((eq? request 'I-lost-my-value)
(process-forget-value))
(else
(error "Unknown request -- SQUARER" request))))
(connect a me)
(connect b me)
me)
3.36
执行
(define a (make-connector))
(define b (make-connector))
之后的环境图如下：
+--------------------------------------------------------------------------------------------------------------------------+
| |
global --> | a b |
env | | | |
+--|-------------------------------------------------------------|---------------------------------------------------------+
| ^ | ^
| | | |
| +------------------+ | +------------------+
| | | | | |
| | value: #f | | | value: #f |
| | informant: #f | | | informant: #f |
| | constraints: '() | | | constraints: '() |
| | | | | |
| | |<--------+ | | |<--------+
| | | | | | | |
| | set-my-value: -------> [*][*] | | set-my-value: -------> [*][*]
| | | parameters: newvalue setter | | | parameters: newvalue setter
| | | body: ... | | | body: ...
| | | | | |
| | |<--------+ | | |<--------+
| | | | | | | |
| | forget-my-value: ----> [*][*] | | forget-my-value: ----> [*][*]
| | | parameters: retractor | | | parameters: retractor
| | | body: ... | | | body: ...
| | | | | |
| | |<--------+ | | |<--------+
| | | | | | | |
| | connect: ------------> [*][*] | | connect: ------------> [*][*]
| | | parameters: new-constraint | | | parameters: new-constraint
| | | body: ... | | | body: ...
| | | | | |
| | |<--------+ | | |<--------+
| | | | | | | |
+---------->me: -----------------> [*][*] +------>me: -----------------> [*][*]
| | parameters: request | | parameters: request
| | body: ... | | body: ...
| | | |
+------------------+ +------------------+
当 (set-value! a 10 ‘user) 执行到 (for-each-except setter inform-about-value constraints) 这一步时，环境图如下：
+---------------------------------------------------------------------------------------------------------------------------+
| |
| inform-about-value |
| | |
global --> | a | b |
env | | set-value! | | |
+--|---------------------------------------------|-------------|-----|------------------------------------------------------+
| ^ | ^ | ^ | ^
| | [*][*] | | | |
| +------------------+ parameters: | | | +------------------+
| | | connector | | | | |
| | value: 10 | new-value | | | | value: #f |
| | informant: 'user | informant | | | | informant: #f |
| | constraints: '() | body: ... | | | | constraints: '() |
| | | | | | | |
| | |<--------+ | | | | |<--------+
| | | | | | | | | |
| | set-my-value: -------> [*][*] | | | | set-my-value: -------> [*][*]
| | | parameters: newvalue setter | | | | | parameters: newvalue setter
| | | body: ... | | | | | body: ...
| | | | | | | |
| | |<--------+ | | | | |<--------+
| | | | | | | | | |
| | forget-my-value: ----> [*][*] | | | | forget-my-value: ----> [*][*]
| | | parameters: retractor | | | | | parameters: retractor
| | | body: ... | | | | | body: ...
| | | | | | | |
| | |<--------+ | | | | |<--------+
| | | | | | | | | |
| | connect: ------------> [*][*] | | | | connect: ------------> [*][*]
| | | parameters: new-constraint | | | | | parameters: new-constraint
| | | body: ... | | | | | body: ...
| | | | | | | |
| | |<--------+ | | | | |<--------+
| | | | | | | | | |
+---------->me: -----------------> [*][*] | | +------>me: -----------------> [*][*]
| | parameters: request | | | | parameters: request
| | body: ... | | | | body: ...
| | | | | |
+------------------+ | | +------------------+
^ | |
| | |
(set-my-value 10 'user) | | |
| | |
| | |
+------------------+ | |
| | | |
| newval: 10 | | |
| setter: 'user | | |
| | | |
+------------------+ | |
^ | |
| | |
(for-each-except | | |
'user | | |
inform-about-new-value | | |
'()) | | |
| | |
| | |
+--------------------+ | |
| | | |
| exception: 'user | inform-about-value v |
| procedure:-----------------------------------> [*][*]
| constraints: '() | parameters: constraint
| | body: (constraint 'I-have-a-value)
| |<---------+
| | |
| loop: ------------------> [*][*]
| | parameters: items
| | body: ...
| |
+--------------------+
^
|
(loop '()) |
|
|
+--------------------+
| |
| items: '() |
| |
+--------------------+
(cond
((null? items)
'done)
((eq? (car items) exception)
(loop (cdr items)))
(else
(procedure (car items))
(loop (cdr items))))
注意 a 的内部环境中的 value 和 informant 都被改变了，执行的最后返回 ‘done 。
3.37
(define (c- a b)
(let ((result (make-connector)))
(adder result b a)
result))
(define (c+ a b)
(let ((result (make-connector)))
(adder a b result)
result))
(define (c* a b)
(let ((result (make-connector)))
(multiplier a b result)
result))
(define (c/ a b)
(let ((result (make-connector)))
(multiplier result b a)
result))
(define (cv a)
(let ((result (make-connector)))
(constant a result)
result))
3.38
a)
假设银行按先来先服务(first come first service) 的方式处理业务，那么 Peter 、 Paul 和 Mary 的交易有以下六种可能的排列方式：
Peter -> Paul -> Mary
Peter -> Mary -> Paul
Paul -> Peter -> Mary
Paul -> Mary -> Peter
Mary -> Peter -> Paul
Mary -> Paul -> Peter
以上的这些排列方式会产生以下的余额值（括号里面表示的是执行操作之后的余额）：
1.Peter (110) -> Paul (90) -> Mary (45)
2.Peter (110) -> Mary (55) -> Paul (35)
3.Paul (80) -> Peter (90) -> Mary (45)
4.Paul (80) -> Mary (40) -> Peter (50)
5.Mary (50) -> Peter (60) -> Paul (40)
6.Mary (50) -> Paul (30) -> Peter (40)
(b)
分情况
1.Peter最后完成写，按不同时刻读取有结果：110， 90， 60， 50， 40
2.Paul 最后完成写，按不同时刻读取有结果：80， 90， 30， 40，35
3.Mary 最后完成写，按不同时刻读取有结果：50，55，40，45
总结一下也就是 110，90，80，60，55，50，45，40，35，30 共10中不同结果
3.39
(set! x (+ 10 1)) => x = 11 => (set! x (* 11 11)) => x = 121
(set! x ?) => (set! x (+ 10 1)) => x = 11 => (set! x (* 11 11)) => x = 121
(set! x (* 10 10)) => x = 100 => (set! x (+ 100 1)) => x = 101
3.40
引自解题集
P：(set! x (* x x))应理解为两次读取x与一次写入x，我们分别记作r11，r12，w1 Q：(set! x (* x x x))应理解为三次读取x与一次写入x，我们分别记作r21，r22，r23，w2
在保持r11，r12，w1和r21，r22，r23，w2各自内部顺序不变，可以交错排序，因此有 7!/(3!4!) = 35 种不同排法
但考虑到正真影响最后结果的却是 （1）w1，w2 的顺序 （2）w1，r21，r22，r23 的顺序 （3）w2，r11，r12 的顺序
考虑（1）将影响最后的写入操作、（2）将影响Q的读取操作进而影响w2、（3）将影响P的读取操作进而影响w1
分两类
类一：最后完成写操作的是w1，因此它始终在r21，r22，r23之后，所以没有（2）的影响，也就不会影响w2的结果，w2 =1,000，这时只考虑（3） （i） w2-r11-r12：r11和r12都读取 x=1,000，故 w1 = 1,000,000 （ii） r11-w2-r12：r11读取 x=10，r12读取，x=1,000，故 w1 = 10,000 （iii） r11-r12-w2：r11和r12都读取 x=10，故 w1 = 100
类二：最后完成写操作的是w2，因此它始终在r11，r12之后，所以没有（3）的影响，也就不会影响w1的结果，w1 100，这时只考虑（2） （i） w1-r21-r22-r23：r21，r22和r23都读取 x=100，故 w2 = 1,000,000 （ii） r21-w1-r22-r23：r21读取 x=10，r22和r23读取，x=100，故 w2 = 100,000 （iii） r21-r22-w1-r23：r21和r22都读取 x=10，r23读取 x=100，故 w2 = 10,000 （iv） r21-r22-w1-r23：r21，r22和r23都读取 x=10，故 w2 = 1,000
综合以上结果，最后可能的值一共有5种：100，1,000，10,000，100,000，1,000,000
串行化
如果将串行化之后的过程 (s (lambda () (set! x (* x x)))) 定义为 P1 ， (s (lambda () (set! x (* x x x)))) 定义为 P2 ，那么 P1 和 P2 有以下可能的计算序列：
P1 –> P2
P2 –> P1
它们分别计算出以下结果：
(* 10 10) => 100 => (* 100 100 100) => 1,000,000
(* 10 10 10) => 1000 => (* 1000 1000) => 1,000,000
因为乘法的交换率原则，只要 P1 和 P2 的执行步骤不交错的话，那么它们之间的运行先后顺序是没有关系的，这也是加速一些并行操作常用的技巧。
3.41
没有必要，因为取余额的操作是一个只读取的操作，并不会修改balance的值，没有必要串行化
3.42
参考解题集
Ben 的程序并不安全，而且会阻止单一对象进行并发。
考虑原本未修改的 make-account 程序，如果执行以下的求值序列的话，那么所有表达式都会被放进串行化组 protected 当中，其中每个操作符都是一个 protected 的串行化实例：
((protected withdraw) 10)
((protected withdraw) 20)
((protected withdraw) 30)
((protected withdraw) 40)
现在，想想使用 Ben 的 make-account 执行上面的求值序列会发生什么事情：它会用同一个 protected-withdraw 串行化对象处理所有调用请求：
(protected-withdraw 10)
(protected-withdraw 20)
(protected-withdraw 30)
(protected-withdraw 40)
假设解释器正在处理 (protected-withdraw 10) ，这时其他三个表达式也开始并发地运行，那么除了 (protected-withdraw 10) 之外，其他三个表达式都会出错，因为运行中的串行化进程是不能被其他过程所干扰的。
3.43
(一些说理题会参考解题集)
这个练习可以分为三个子问题。
问题一
练习的第一个问题是：证明如果交换过程是按顺序执行的，那么经过任意次数的并发交换之后，这些账户的月还是按照某种顺序排列的 10 、 20 和 30 。
假如交换过程是按顺序运行的，那么交换 10 、 20 和 30 有以下可能的并发运行序列（ e 代表 exchange ）：
; 运行序列 ; 相应的决策树表示
(e 10 20) => (e 10 30) (e 10 20)
/ \
(e 10 20) => (e 20 30) / \
(e 10 30) (e 20 30)
(e 10 30) => (e 10 20) (e 10 30)
/ \
(e 10 30) => (e 20 30) / \
(e 10 20) (e 20 30)
(e 20 30) => (e 10 20) (e 20 30)
/ \
(e 20 30) => (e 10 30) / \
(e 10 20) (e 10 30)
对以上六个序列进行检验会发现，无论交换怎么进行，最终三个帐号的余额都会是某种排列的 10 、 20 和 30 。
问题二
练习的第二个问题是：证明如果使用未串行化的 exchange 实现账户余额交换，那么三个帐号之间的余额就可能不再是 10 、 20 和 30 的某个排列。
这个论断是正确的，以下是其中一个例子，它通过交换，产生三个余额分别为 20 、 10 和 10 的账户：
| acc-1 acc-2 acc-3
| | | |
| | | |
| +-----------------------------------------+ |
| | exchange |
| | | |
| | v |
| | acc-1 balance: 10 |
| | | |
| | v |
| | acc-2 balance: 20 |
| | | |
| | | |
| | | |
| | | |
| +---------------------------------------------------------------------------------------+
| | exchange
| | |
| | v
| | acc-1 balance: 10
| | |
| | v
| | acc-3 balance: 30
| | |
| | v
| | difference: (- 10 30) = -20
| | |
| | v
| | ((acc-1 'withdraw) -20)
| | |
| | v
| | acc-1 balance: 10 + 20 = 30
| | |
| | v
| | ((acc-3 'deposit) -20)
| | |
| | v
| | acc-3 balance: 30 - 20 = 10
| |
| v
| difference: (- 10 20) = -10
| |
| v
| ((acc-1 'withdraw) -10)
| |
| v
| acc-1 balance: 10 + 10 = 20
| |
| v
| ((acc-2 'deposit) -10)
| |
| v
| acc-2 balance: 20 - 10 = 10
|
v
time
注意，当输入为负数时，帐号执行的是反操作，比如 ((acc-1 ‘withdraw) -10) ，实际上执行的是 ((acc-1 ‘deposit) 10) 。
问题三
练习的第三个问题是：如果不对 exchange 进行串行化，无论并发如何进行，总能保证三个帐号的余额的总和不变吗？
在问题二的例子中，我们已经给出了可以计算出余额为 20 、 10 和 10 的交换运行序列，它在这里也可以作为反例，证明这个论断是错误的。
3.44
Louis 的话只是对了一半， transfer 的确需要更使用更复杂精细的方法去处理，但并不是在处理交换问题时的做法(使用两个串行化来保证正确性)。
将 W 定义表达式 ((from-account ‘withdraw) amount) ，将 D 定义为 ((to-account ‘deposit) amount) ， Others 定义为在转帐过程中可能并行运行的一条或多条表达式，那么对于 W 、 D 和 Others 三个定义，有以下可能的并发执行序列：
W -> D -> Others
W -> Others -> D
对于以上的执行序列， transfer 都总能完成 W 和 D ，而 W 和 D 都已经进行了串行化以保证单个操作可以正确执行，因此，我们没有必要再给 transfer 加上其他串行化设置。
至于为什么要用两个串行化来保证 exchange 的安全性而 transfer 不用？答案是因为 transfer 不需要计算两个帐号之间的中间值 difference ，它只需要分别对两个帐号执行 W 和 D 操作就行了。
3.45
在exchange最后一步时会调用 balance-serializer对 withdraw 操作进行串行化，但是balance-serializer先前已经被调用过了，运行 withdraw 和 exchange 的两个过程都会被阻塞，产生死锁。
3.46
| P1 mutex P2
| | |
| | |
| | |
| +----------------------------> false <----------------------------+
| test-and-set! test-and-set!
| | |
| | |
| +---------------------> true <---------------------+
| (begin (set-car! cell true) (begin (set-car! cell true)
| false) false)
|
v
time
3.47
(define (make-serializer)
(let ((mutex (make-mutex)))
(lambda (p)
(define (serialized-p . args)
(mutex 'acquire)
(let ((val (apply p args)))
(mutex 'release)
val))
serialized-p)))
(define (make-mutex)
(let ((cell (list false)))
(define (the-mutex m)
(cond ((eq? m 'acquire)
(if (test-and-set! cell)
(the-mutex 'acquire)))
((eq? m 'release)
(clear! cell))))
the-mutex))
(define (clear! cell)
(set-car! cell false))
(define (test-and-set! cell)
(if (car cell)
true
(begin (set-car! cell true)
false)))
(define (make-semaphore n)
(let ((mutex (make-mutex)))
(define (acquire)
(mutex 'acquire)
(if (> n 0)
(begin (set! n (- n 1))
(mutex 'release)
'ok)
(begin (mutex 'release)
(acquire))))
(define (release)
(mutex 'acquire)
(set! n (+ n 1))
(mutex 'release)
'ok)
(define (dispatch m)
(cond ((eq? m 'acquire) (acquire))
((eq? m 'release) (release))
(else (error "Unknown mode MAKE-SEMAPHORE" m))))
dispatch))
(define (make-semaphore n)
(let ((mutex (make-mutex)))
(define (acquire)
(if (test-and-set! n)
(acquire)
'ok))
(define (release)
(set! n (+ n 1))
'ok)
(define (dispatch m)
(cond ((eq? m 'acquire) (acquire))
((eq? m 'release) (release))
(else (error "Unknown mode MAKE-SEMAPHORE" m))))
dispatch))
(define (test-and-set! n)
(if (= n 0)
#t
(begin (set! n (- n 1))
#f)))
3.48
(define (make-account balance)
(let ((id (new-id)))
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(let ((balance-serializer (make-serializer)))
(define (dispatch m)
(cond
((eq? m 'withdraw)
withdraw)
((eq? m 'deposit)
deposit)
((eq? m 'balance)
balance)
((eq? m 'serializer)
balance-serializer)
((eq? m 'id)
id)
(else
(error "Unknown request -- MAKE-ACCOUNT" m))))
dispatch)))
(define (counter)
(let ((i 0))
(lambda ()
(set! i (+ 1 i))
i)))
(define new-id (counter))
(define (serialized-exchange x y)
(if (< (x 'id) (y 'id))
(serialize-and-exchange x y)
(serialize-and-exchange y x)))
(define (serialize-and-exchange small big)
(let ((s-ser (small 'serializer)))
(let ((b-ser (big 'serializer)))
((s-ser (b-ser exchange))
small
big))))
3.49
假设 peter 和 mary 是两夫妇，他们各自拥有自己的帐号 peter-acc 和 mary-acc ，并且这两个帐号都将对方的帐号设置成了关联帐号，也即是，当 peter-acc 的余额不足以支付的时候，它会去提取 mary-acc 的余额；而当 mary-acc 的余额不足以支付的时候，它也回去提取 peter-acc 的余额。
现在，考虑这样一种情况， peter 和 mary 分别在不同的地方消费，然后各自账户的余额都不足以支付订单，于是 peter-acc 尝试访问关联帐号 mary-acc ，而 mary-acc 也在同一时间访问 peter-acc ，因为两个帐号都已经被打开，而且两个帐号都试图访问关联帐号，这样就造成了一个死锁：除非 peter 或 mary 的其中一个主动退出账户，否则支付永远都无法完成
3.50
(define (stream-map proc . argstreams)
(if (stream-null? (car argstreams))
the-empty-stream
(cons-stream
(apply proc (map (lambda (s) (stream-car s)) argstreams))
(apply stream-map
(cons proc (map (lambda (s) (stream-cdr s)) argstreams))))))
3.51
1 ]=> (define (show x)
(display x)
x)
;Value: show
1 ]=> (define x (stream-map show (stream-enumerate-interval 0 10))) ; 只有流的 stream-car 部分被求值(延迟求值的效果)
0
;Value: x
1 ]=> (stream-ref x 5) ; 只计算所需的值，不多也不少(延迟求值的效果)
12345
;Value: 5
1 ]=> (stream-ref x 7) ; 只需计算 6 和 7 ，没有重复计算(记忆性过程和延时求值的效果)
67
;Value: 7
3.52
从 sum 的值可以看出，在定义 seq 的时候，只有 1 被求值了：
1 ]=> (define seq (stream-map accum (stream-enumerate-interval 1 20)))
;Value: seq
1 ]=> sum
;Value: 1
从 sum 的值可以看出，在定义 y 的时候， seq 的求值进行到了 3 就停止了，因为 3 是 stream-filter 遇到的第一个非偶数值，其中 sum = 1 + 2 + 3 = 6 ：
1 ]=> (define y (stream-filter even? seq))
;Value: y
1 ]=> sum
;Value: 6
从 sum 的值可以看出，在定义 z 的时候， seq 的求值进行到 4 就停止了，这时 sum = 1 + 2 + 3 + 4 = 10 ：
1 ]=> (define z (stream-filter (lambda (x)
(= (remainder x 5) 0))
seq))
;Value: z
1 ]=> sum
;Value: 10
调用 (stream-ref y 7) 会让 y 被强迫求值，一直到第七个元素为止，这时 sum 也被设为了 (stream-ref y 7) 的值：
1 ]=> (stream-ref y 7)
;Value: 136
1 ]=> sum
;Value: 136
使用 display-stream 会强迫整个流求值：
1 ]=> (display-stream z)
10
15
45
55
105
120
190
210
;Unspecified return value
1 ]=> sum
;Value: 210
最后的问题是，如果将 (delay <exp) 的实现从 memo-proc 改为 (lambda ()
答案是，如果不使用记忆过程的话，那么对 seq 流的求值就会产生重复计算，而每次重复对 seq 的流的求值，都会引起 accum 过程的调用，结果会产生一个很不相同的 sum 值。
举个例子，即使再次调用 (display-stream z) ，这里的 sum 值也不会改变，但如果是没有使用记忆过程的 delay 实现，那么 sum 的值将会变成 420 ：
1 ]=> (display-stream z)
10
15
45
55
105
120
190
210
;Unspecified return value
1 ]=> sum
;Value: 210
3.53
2的阶乘,如1,2,4,8,16
3.54
(define (mul-streams s1 s2)
(stream-map * s1 s2))
(define factorials (cons-stream 1 (mul-streams factorials (stream-cdr integers))))
3.55
(define (partial-sums s)
(cons-stream (stream-car s) (add-streams (partial-sums s) (stream-cdr s))))
3.56
(define s (cons-stream 1
(merge (scale-stream s 2)
(merge (scale-stream s 3)
(scale-stream s 5)))))
3.57
从书本 227 页的 fibs 定义以及 229 页的 fibs 图示分析可知，对于第 i 个斐波那契数，也即是 (stream-ref fibs i) ，需要对 (stream-ref fibs (- i 1)) 和 (stream-ref fibs (- i 2)) 进行一次加法。
对于使用记忆过程实现的，无重复的 fibs 来说，每个 (stream-ref fibs i) 只需要被计算一次，以后就可以根据记忆过程来直接返回计算结果。
因此，计算 (stream-ref fibs n) 总共需要 n 次加法，它产生的计算序列和书本 26 页的迭代版本的 fib 过程是一样的。
另一方面，如果使用不带记忆过程的 lambda 来实现 delay ，那么对于每个 (stream-ref fibs i) ，都要对 (stream-ref fibs (- i 1)) 和 (stream-ref fibs (- i 2)) 进行一次加法，而对 (stream-ref fibs (- i 1)) 的求值又引发 (stream-ref fibs (-i 2) 和 (stream-ref fibs (- i 3)) 进行相加，以此类推，一直回溯到 0 和 1 为止，这一计算所产生的加法序列和书本 24 页指数级复杂度的递归 fib 过程产生的加法序列一样，因此这一实现所需的加法将指数倍地上升。
3.58
;从定义来看， expand 每次生成 (* num radix) 除以 den 的商，然后将 (* num radix) 除以 den 的余数作为 num 参数，递归地调用 expand ：
1 ]=> (stream-head (expand 1 7 10) 20)
;Value 13: (1 4 2 8 5 7 1 4 2 8 5 7 1 4 2 8 5 7 1 4)
1 ]=> (stream-head (expand 3 8 10) 20)
;Value 14: (3 7 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
3.59
(define (div-streams s1 s2)
(stream-map / s1 s2))
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
(define integers (integers-starting-from 1))
(define (integrate-series s)
(mul-streams s
(div-streams ones integers)))
(define cosine-series
(cons-stream 1
(integrate-series
(cons-stream
0
(integrate-series
(stream-map - cosine-series))))))
(define sine-series
(cons-stream 0 (integrate-series
1
(cons-stream
(integrate-series
(stream-map - sine-series))))))
3.60
(define (mul-series s1 s2)
(cons-stream (* (stream-car s1) (stream-car s2))
(add-streams
(add-streams (scale-stream (stream-cdr s1) (stream-car s2))
(scale-stream (stream-cdr s2) (stream-car s1)))
(cons-stream 0
(mul-series (stream-cdr s1)
(stream-cdr s2))))))
3.61
(define (X s)
(cons-stream 1
(mul-series (stream-map - (stream-cdr s))
(X s))))
3.62
(define (div-series s1 s2)
(if (= (stream-car s2) 0)
(error "denominator is 0!")
(mul-series s1
(scale-stream (X (scale-stream s2 (/ 1 (stream-car s2))))
(/ 1 (stream-car s2))))))
3.63
在没有记忆的情况下，每次计算出新值都需要重新计算先前的值，明显拖累了效率。直接采用lambda而不用memp-proc在效率方面 和Louis没有差异。
3.64
(define (stream-limit s limit)
(let ((front (stream-car s))
(back (stream-car (stream-cdr s))))
(if (> limit (abs (- front back)))
back
(stream-limit (cdr s) limit))))
3.65
(define (ln2-stream n)
(cons-stream (/ 1.0 n)
(stream-map - (ln2-stream (+ n 1)))))
(define ln2
(partial-sums (ln2-stream 1)))
(stream-head ln2 10)
(1. .5 .8333333333333333 .5833333333333333 .7833333333333332 .6166666666666666 .7595238095238095 .6345238095238095 .7456349206349207 .6456349206349207)
(stream-head (euler-transform ln2) 10)
(.7 .6904761904761905 .6944444444444444 .6924242424242424 .6935897435897436 .6928571428571428 .6933473389355742 .6930033416875522 .6932539682539683 .6930657506744464)
(stream-head (accelerated-sequence euler-transform ln2) 9)
(1. .7 .6932773109243697 .6931488693329254 .6931471960735491 .6931471806635636 .6931471805604039 .6931471805599445 .6931471805599427)
3.66
1 ]=> (define before-1-100 (stream->list
(stream-take-while
(lambda (pair)
(not (equal? pair '(1 100))))
(pairs integers integers))))
1 ]=> (length before-1-100)
;Value: 197
;100-100的数量非常大以至于无法查看结果。
3.67
(define (pair s t)
(cons-stream
(list (stream-car s) (stream-car t))
(interleave
(stream-map (lambda (x) (list x (stream-car t)))
(stream-cdr s))
(interleave
(stream-map (lambda (x) (list (stream-car s) x))
(stream-cdr t))
(pairs (stream-cdr s) (stream-cdr t))))))
3.68
https://www.cnblogs.com/violeshnv/p/17181891.html#modularity-objects-and-state
显然会栈溢出，interleave 是一个函数，要求它的参数在使用前被计算为值，尝试计算 (pairs (stream-cdr s) (stream-cdr t)) 导致无限递归，最终溢出。
3.69
https://www.cnblogs.com/violeshnv/p/17181891.html#modularity-objects-and-state
(define (triples s t u)
(cons-stream
(list (stream-car s) (stream-car t) (stream-car u))
(interleave
(stream-map (lambda (x)
(list (stream-car s)
(stream-car t)
x))
(stream-cdr u))
(interleave
(stream-map (lambda (y)
(cons (stream-car s) y))
(pairs (stream-cdr t)
(stream-cdr u)))
(triples (stream-cdr s)
(stream-cdr t)
(stream-cdr u))))))
(define pythagorean-triples
(stream-filter (lambda (triple)
(= (square (caddr triple))
(+ (square (cadr triple))
(square (car triple)))))
(triples integers integers integers)))
3.70
(define (stream-filter pred stream)
(cond ((stream-null? stream) the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred
(stream-cdr stream))))
(else (stream-filter pred (stream-cdr stream)))))
(define (square x)
(* x x))
(define (stream-map proc s)
(if (stream-null? s)
the-empty-stream
(cons-stream (proc (stream-car s))
(stream-map proc (stream-cdr s)))))
(define (interleave s1 s2)
(if (stream-null? s1)
s2
(cons-stream (stream-car s1)
(interleave s2 (stream-cdr s1)))))
(define (merge-weighted s1 s2 weight)
(cond ((stream-null? s1) s2)
((stream-null? s2) s1)
(else
(let ((s1car (stream-car s1))
(s2car (stream-car s2)))
(cond ((< (weight s1car) (weight s2car))
(cons-stream s1car (merge-weighted (stream-cdr s1) s2 weight)))
((> (weight s1car) (weight s2car))
(cons-stream s2car (merge-weighted s1 (stream-cdr s2) weight)))
(else
(cons-stream s1car
(merge-weighted (stream-cdr s1)
(stream-cdr s2)
weight))))))))
(define pair-s1 (pairs integers integers))
(define pair-s2 (pairs integers integers))
(define plus-sort
(merge-weighted pair-s1 pair-s2 (lambda (x) (+ (car x) (cadr x)))))
(define (p? x)
(or (= (remainder x 2) 0)
(= (remainder x 3) 0)
(= (remainder x 5) 0)))
(define 2-3-5-s1
(stream-filter (lambda (x) (or (p? (car x)) (p? (cadr x))))
(pairs integers integers)))
(define 2-3-5-s2
(stream-filter (lambda (x) (or (p? (car x)) (p? (cadr x))))
(pairs integers integers)))
(define 2-3-5-sort
(merge-weighted 2-3-5-s1
2-3-5-s2
(lambda (x) (+ (* 2 (car x))
(* 3 (cadr x))
(* 5 (car x) (cadr x))))))
(define (ste stream step)
(if (= step 0)
'ok
(begin (display (stream-car stream))
(ste (stream-cdr stream) (- step 1)))))
(define (weighted-pairs s1 s2 weight)
(cons-stream (list (stream-car s1) (stream-car s2))
(merge-weighted (stream-map (lambda (x) (list (stream-car s1) x))
(stream-cdr s2))
(weighted-pairs (stream-cdr s1) (stream-cdr s2)
weight)
weight)))
3.71
(define (triple x) (* x x x))
(define (sum-triple x) (+ (triple (car x)) (triple (cadr x))))
(define (Ramanujan-number s)
(if(= (sum-triple (stream-car s))
(sum-triple (stream-car (stream-cdr s))))
(cons-stream (sum-triple (stream-car s))
(Ramanujan-number (stream-cdr (stream-cdr s))))
(Ramanujan-number (stream-cdr s))))
(define Ramanujan
(Ramanujan-number (weighted-pairs integers integers sum-triple)))
按理说没问题的..可是测试时输出不了结果
3.72
(define (square x)
(* x x))
(define (sum-square x)
(+ (square (car x)) (square (cadr x))))
(define (sq s)
(define (stream-cadr s) (stream-car (stream-cdr s)))
(define (stream-caddr s) (stream-car (stream-cdr (stream-cdr s))))
(if (= (sum-square (stream-car s))
(sum-square (stream-cadr s))
(sum-square (stream-caddr s)))
(cons-stream (sum-square (stream-car s))
(sq (stream-cdr (stream-cdr (stream-cdr s)))))
(sq (stream-cdr s))))
(define square-number
(sq (weighted-pairs integers integers sum-square)))
3.73
(define (RC R C dt)
(lambda (i v0)
(add-streams (scale-stream i R)
(integral (scale-stream i (/ 1 C)) v0 dt))))
3.74
(define zero-crossings
(stream-map sign-change-detector
sense-data
(cons-stream 0 sense-data)))
3.75
我们应该同时记录平均值和真实值,先前的版本污染了last-value
(define (make-zero-crossings input-stream last-value last-average)
(let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
(cons-stream (sign-change-detector avpt last-average)
(make-zero-crossings (stream-cdr input-stream)
(stream-car input-stream)
avpt))))
3.76
(define (smooth input)
(cons-stream (/ (+ (stream-car input) (stream-car (stream-cdr input))) 2)
(smooth (stream-cdr input))))
(define (make-zero-crossings input-stream)
(let ((improve (smooth input-stream)))
(stream-map sign-change-detector
improve
(cons-stream 0 improve))))
3.77
(define (integral delayed-integrand initial-value dt)
(cons-stream initial-value
(let ((integrand (force delayed-integrand)))
(if (stream-null? integrand)
the-empty-stream
(integral (delay (stream-cdr integrand))
(+ (* dt (stream-car integrand))
initial-value)
dt)))))
3.78
(define (solve-2nd a b dt y0 dy0 dy/dt)
(define y (integral (delay dy) y0 dt))
(define dy (integral (dalay ddy) dy0 dy/dt))
(define ddy (add-streams (scale-stream dy a)
(scale-stream y b)))
y)
3.79
(define (solve-2nd f y0 dy0 dt)
(define y (integral (delay dy) y0 dt))
(define dy (integral (delay ddy) dy0 dt))
(define ddy (stream-map f dy y))
y)
3.80
(define ((RLC R L C dt) vc0 il0)
(define vc (integral (delay dvc) vc0 dt))
(define il (integral (delay dil) il0 dt))
(define dvc (scale-stream il (/ -1 C)))
(define dil (add-streams (scale-stream vc (/ 1 L))
(scale-stream il (/ R L -1))))
(stream-map cons vc il))
3.81
(define (make-random init-value)
(define x
(cons-stream (random-update init-value)
(stream-map random-update x)))
x)
(define (random-ser input-s)
(define (iter request-s random-s)
(if (stream-null? input-s)
the-empty-stream
(cond
((eq? (stream-car request-stream) 'generate)
(cons-stream
(stream-car random-s)
(iter (stream-cdr request-s)
(stream-cdr random-s))))
((and (pair? (stream-car request-stream)) (eq? (car (stream-car request-stream)) 'reset))
(cons-stream
#t
(iter (stream-cdr request-s)
(make-random (cdr (stream-car request-s))))))
(else
(error "unknown request")))))
(iter input-s (make-random 0)))
3.82
(define (estimate-integral pred x1 x2 y1 y2)
(define (random-pair)
(cons-stream (cons (random 1.0) (random 1.0))
(random-pair)))
(define (monte-carlo experiment-s passed total)
(if (stream-null? experiment-s)
(/ passed total)
(let ((result (stream-car experiment-s)))
(if result
(monte-carlo (stream-cdr experiment-s)
(+ passed 1)
(+ total 1))
(monte-carlo (stream-cdr experiment-s)
passed
(+ total 1))))))
(monte-carlo (stream-map pred (random-pair)) 0 0))
(define π-stream
(scale-stream
(estimate-integral
(lambda (p)
(> 1 (+ (square (car p))
(square (cdr p)))))
-1 1 -1 1)
4.0))