第三章习题 3.21 - 3.37 的解答。
E-3.21: 因为 queue 只记录队头指针和队尾指针，而打印 front-ptr 的时候把整个队列都打印出来了，打印 rear-ptr 只打印最后一个元素。最后有一组 (#<void> #<void>) 应该是 map 的返回值。
(load "../examples/3.3.2-representing-queues.scm")
(define (print-queue q)
(define (iter current end)
(if (eq? current end)
(map display (list (car current) "\n"))
(begin (map display (list (car current) " "))
(iter (cdr current) end))))
(if (empty-queue? q)
(display "nil\n")
(iter (front-ptr q) (rear-ptr q))))
; -------------------------------------------------------
(define q1 (make-queue))
(insert-queue! q1 'a)
(insert-queue! q1 'b)
(delete-queue! q1)
(delete-queue! q1)
(print-queue q1)E-3.22: 有点面向对象的感觉。
(define (make-queue)
(let ((front-ptr '())
(rear-ptr '()))
(define (empty-queue?)
(null? front-ptr))
(define (front-queue)
(if (empty-queue?)
'()
(car front-ptr)))
(define (insert-queue! item)
(let ((new-pair (cons item '())))
(cond ((empty-queue?)
(set! front-ptr new-pair)
(set! rear-ptr new-pair))
(else
(set-cdr! rear-ptr new-pair)
(set! rear-ptr new-pair)))))
(define (delete-queue!)
(if (not (empty-queue?))
(set! front-ptr (cdr front-ptr))))
(define (print-queue)
(define (iter current end)
(if (eq? current end)
(map display (list (car current) "\n"))
(begin (map display (list (car current) " "))
(iter (cdr current) end))))
(if (empty-queue?)
(display "nil\n")
(iter front-ptr rear-ptr)))
(define (dispatch m)
(cond ((eq? m 'empty-queue?) empty-queue?)
((eq? m 'front-queue) front-queue)
((eq? m 'insert-queue!) insert-queue!)
((eq? m 'delete-queue!) delete-queue!)
((eq? m 'print-queue) print-queue)))
dispatch))
; -------------------------------------------------------
(define q (make-queue))
((q 'insert-queue!) 'x)
((q 'insert-queue!) 'y)
((q 'print-queue))
((q 'delete-queue!))
((q 'print-queue))E-3.23: 使用三元组，第一个元素是插入的 item，第二个元素指向前一个 item，第三个元素指向后一个 item，相当于双链表。
(define (make-deque)
(let ((front-ptr '())
(rear-ptr '()))
(define (empty-deque?)
(null? front-ptr))
(define (front-deque)
(if (empty-deque?)
'()
(car front-ptr)))
(define (rear-deque)
(if (empty-deque?)
'()
(car rear-ptr)))
(define (front-insert-deque! item)
(let ((new-item (cons (cons item '()) '())))
(cond ((empty-deque?)
(set! front-ptr new-item)
(set! rear-ptr new-item))
(else
(set-cdr! new-item front-ptr)
(set-cdr! (car front-ptr) new-item)
(set! front-ptr new-item)))))
(define (rear-insert-deque! item)
(let ((new-item (cons (cons item '()) '())))
(cond ((empty-deque?)
(set! front-ptr new-item)
(set! rear-ptr new-item))
(else
(set-cdr! (car new-item) rear-ptr)
(set-cdr! rear-ptr new-item)
(set! rear-ptr new-item)))))
(define (front-delete-deque!)
(if (not (empty-deque?))
(begin (set! front-ptr (cdr front-ptr))
(set-cdr! (car front-ptr) '()))))
(define (rear-delete-deque!)
(if (not (empty-deque?))
(begin (set! rear-ptr (cdar rear-ptr))
(if (null? rear-ptr)
(set! front-ptr '())
(set-cdr! rear-ptr '())))))
(define (print-deque)
(define (iter current end)
(if (eq? current end)
(map display (list (caar current) "\n"))
(begin (map display (list (caar current) " "))
(iter (cdr current) end))))
(if (empty-deque?)
(display "nil\n")
(iter front-ptr rear-ptr)))
(define (dispatch m)
(cond ((eq? m 'empty-deque?) empty-deque?)
((eq? m 'front-deque) front-deque)
((eq? m 'front-insert-deque!) front-insert-deque!)
((eq? m 'front-delete-deque!) front-delete-deque!)
((eq? m 'rear-insert-deque!) rear-insert-deque!)
((eq? m 'rear-delete-deque!) rear-delete-deque!)
((eq? m 'print-deque) print-deque)))
dispatch))
; ------------------------------------------------------------------
(define q (make-deque))
((q 'rear-insert-deque!) 'x)
((q 'print-deque))
((q 'front-insert-deque!) 'y)
((q 'print-deque))
((q 'front-delete-deque!))
((q 'print-deque))
((q 'rear-delete-deque!))
((q 'print-deque))E-3.24: 给 make-table 多加一个参数“same-key?”，把 assoc 的定义挪到 make-table 中，并且把 assoc 中的 equal? 改为 same-key? 即可。
E-3.25: 因为题目要求可以有任意个 key（也就是说不是每个节点的层数都一样），所以需要为每个节点增加一个域表明该节点关联的 value 是一个值还是一个 table。
E-3.26: 每个节点包含 4 个域：left-branch，right-branch，key，data。同一层的节点组成二叉树，data 域指向下一层的根节点。
E-3.27: 图如下。因为在算过的结果已经被保存起来，因此算后面的结果时可以直接使用前面的结果，也就是每次只需算一个加法 f(n-1)+f(n-2)，其中 f(n-1) 和 f(n-2) 均已知。将 memo-fib 直接定义成 (memorize fib) 亦可，因为保存和查找的步骤在 memorize 中已经做了，仅当表中没有需要的结果时才会调用fib去算。
+-----------------------+
| memo-fib |
+-----+-----------------+
| ^
| |
| +--------+
| | f: ----+--+
| | table: | |
| | x: 3 | |
v +--------+ |
+--------------+ | v
| (lambda (x) | | +---------------+
| (let ...)) +----+ | (lambda (n) |
+--------------+ | (cond ...)) |
+---------------+E-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-signal! output new-value)))))
(add-action! a1 or-action-procedure)
(add-action! a2 or-action-procedure)
'ok)E-3.29: 根据德摩根定律：
-----
- -
A + B = A . B可得：
(define (or-gate a1 a2 output)
(define (or-action-procedure)
(let ((b1 (make-wire))
(b2 (make-wire))
(c (make-wire)))
(inverter a1 b1)
(inverter a2 b2)
(and-gate b1 b2 c)
(inverter c output)))
(add-action! a1 or-action-procedure)
(add-action! a2 or-action-procedure)
'ok)按照程序的执行顺序，总的延迟应该是 3 inverter_delay + and_delay。实际中两个非门可以同时执行，这时应该是 2 inverter_delay + and_delay。
E-3.30:
(define (ripple-carry-adder addend augend sum carry)
(define (recur a b s)
(if (null? (cdr a))
(begin (full-adder (car a) (car b) 0 s carry)
(set-car! sum s))
(begin (recur (cdr a) (cdr b) s)
(full-adder (car a) (car b) carry s carry)
(set! sum (cons s sum)))))
(if (and (not (null? addend))
(not (null? augend))
(= (length addend) (length augend)))
(recur addend augend '())))由于每一位的计算必须等到前面的进位结果，整个加法是串行执行的，总的延迟是 n full_adder_delay。每个全加器的延迟是 2 个半加器 + or_delay。每个半加器的延迟是 2 and_delay + not_delay + or_delay。
E-3.31: 立即执行一次只是调用 after-delay 把实际需要执行的函数加入到待执行列表中，否则执行 propagate 后从等待队列中找不到需要执行的函数。
E-3.32: 保证执行顺序是因为要模拟实际信号变化的顺序，只有当输入变化了输出才会变化。
E-3.33: 解答这题只需要知道提供的接口用法就行。框图如下：
+-------+ +-------+ +---+
| a | u | x +--+ 2 |
| + s +---+ p * | +---+
| b | | c |
+-------+ +-------+相应的代码：
(load "../examples/3.3.5-propagation-of-constraints.scm")
(define (averager a b c)
(let ((x (make-connector))
(u (make-connector)))
(adder a b u)
(multiplier x c u)
(constant 2 x))
'ok)
(define a (make-connector))
(define b (make-connector))
(define c (make-connector))
(probe "value a" a)
(probe "value b" b)
(probe "value c" c)
(set-value! a 12 'ou)
(set-value! b 36 'ou)
(averager a b c)E-3.34: 题目的写法的问题是，当设定 b 的值时，a 的值不能确定，因为 multiplier 中乘数，被乘数，积三者中至少需确定两者。
E-3.35:
(define (squarer a b)
(define (process-new-value)
(if (has-value? b)
(if (< (get-value b) 0)
(map display (list "square less than 0: SQUARER" (get-value b) "\n"))
(set-value! a (sqrt (get-value b)) me))
(set-value! b (* (get-value a) (get-value a)) me)))
(define (process-forget-value)
(forget-value! a me)
(forget-value! b 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 (map display (list "Unknown request: MULTIPLIER" request "\n")))))
(connect a me)
(connect b me)
me)
; -------------------------------------------------------------------------------------
(load "../examples/3.3.5-propagation-of-constraints.scm")
(define a (make-connector))
(define b (make-connector))
(probe "a" a)
(probe "b" b)
(set-value! b 25 'ou)
(squarer a b)E-3.36: a 和 b 都指向 make-connector 中实现的 me 函数。for-each-except，inform-about-value 都在全局环境中。for-each-except 的参数 constraints 指向 a 中的 constraints。
+-----------------------------------------------------------+
| a b |
+-------+-------------------------+-------------------------+
| ^ | ^
| | | |
| +-------+---------+ | +-------+----------+
| | value: 10 | | | value: false |
| | informant: user | | | informant: false |
| | constraints: () | | | constraints: () |
| +-------+---------+ | +-------+----------+
v ^ v ^
+---+---+ | +---+---+ |
| o | o +-------+ | o | o +-------+
+-+-----+ +-+-----+
| |
v |
+--------------------+ |
| parameter: request |<---------+
| body: (cond ...) |
+--------------------+E-3.37:
(load "../examples/3.3.5-propagation-of-constraints.scm")
(define (c+ x y)
(let ((z (make-connector)))
(adder x y z)
z))
(define (c- z x)
(let ((y (make-connector)))
(adder x y z)
y))
(define (c* x y)
(let ((z (make-connector)))
(multiplier x y z)
z))
(define (c/ z x)
(let ((y (make-connector)))
(multiplier x y z)
y))
(define (cv value)
(let ((v (make-connector)))
(constant value v)
v))
; -----------------------------------------------------------------
(define (celsius-fahrenheit-converter x)
(c+ (c* (c/ (cv 9)
(cv 5))
x)
(cv 32)))
(define C (make-connector))
(probe "C" C)
(set-value! C 100 'ou)
(define F (celsius-fahrenheit-converter C))
(probe "F" F)