Chinaunix

标题: SICP 习题参考答案 3.3 [打印本页]

---

作者: win_hate    时间: 2008-12-13 10:18
标题: SICP 习题参考答案 3.3

此帖为 SICP 章节 3.3 的参考答案。为保持可读性，请勿直接在本帖讨论。讨论请另开新帖。

• 本节电子版：[Modeling with Mutable Data]
  
• 答案目录：[点这里]
  

---

作者: win_hate    时间: 2008-12-13 10:20
标题: Exercise 3.12.
Exercise 3.12.  The following procedure for appending lists was introduced in section 2.2.1:

(define (append x y)
  (if (null? x)
      y
      (cons (car x) (append (cdr x) y))))

Append forms a new list by successively consing the elements of x onto y. The procedure append! is similar to append, but it is a mutator rather than a constructor. It appends the lists by splicing them together, modifying the final pair of x so that its cdr is now y. (It is an error to call append! with an empty x.)

(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)

Here last-pair is a procedure that returns the last pair in its argument:

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

Consider the interaction

(define x (list 'a 'b))
(define y (list 'c 'd))
(define z (append x y))
z
(a b c d)
(cdr x)
<response>
(define w (append! x y))
w
(a b c d)
(cdr x)
<response>

What are the missing <response>s? Draw box-and-pointer diagrams to explain your answer.

---

作者: win_hate    时间: 2008-12-13 10:31
标题: Exercise 3.12. 答案

• 第一个 <response> 是 (b)
  
  此时 z 是通过 (cons 'a (cons 'b y)) 构造出来的，与 x 没有共享部分。
  
  
  1. 
     
  2. > (define x (list 'a 'b))
     
  3. > (define y (list 'c 'd))
     
  4. > (define z (append x y))
     
  5. 
     
  6. > z
     
  7. (a b c d)
     
  8. 
     
  9. > (cdr x)
     
  10. (b)
      

  复制代码
  
  
• 第二个 <response> 是 (b c d)
  
  此时 set-cdr 把 x 最后指向 NULL 的指针指向了  y 的表头。所以 x 就是 w，w 就是 x.（参考 append! 代码的最后一句）
  
  
  1. 
     
  2. > (define w (append! x y))
     
  3. 
     
  4. > w
     
  5. (a b c d)
     
  6. 
     
  7. > (cdr x)
     
  8. (b c d)
     
  9. 
     
  10. > (eq? x w)
      
  11. #t
      
  12. 
      
  13. > (eq? (list 1 2) (list 1 2))
      
  14. #f
      

  复制代码
  
  

---

作者: win_hate    时间: 2008-12-13 10:34
标题: Exercise 3.13.
Exercise 3.13.  Consider the following make-cycle procedure, which uses the last-pair procedure defined in exercise 3.12:

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

Draw a box-and-pointer diagram that shows the structure z created by

(define z (make-cycle (list 'a 'b 'c)))

What happens if we try to compute (last-pair z)?

---

作者: win_hate    时间: 2008-12-13 10:37
标题: Exercise 3.13. 答案

• 表尾指向表头，构成一个环。
  
  
  1. 
     
  2. > (define z (make-cycle (list 'a 'b 'c)))
     
  3. 
     
  4. > z
     
  5. (a b c . #-2#)
     
  6. 
     
  7. > (car z)
     
  8. a
     
  9. 
     
  10. > (cadr z)
      
  11. b
      
  12. 
      
  13. > (caddr z)
      
  14. c
      
  15. 
      
  16. > (cadddr z)
      
  17. a
      

  复制代码
  
  
• 计算 (last-pair z) 将无法终止，直到耗尽所有资源。
  

---

作者: win_hate    时间: 2008-12-13 10:38
标题: Exercise 3.14.
Exercise 3.14.  The following procedure is quite useful, although obscure:

(define (mystery x)
  (define (loop x y)
    (if (null? x)
        y
        (let ((temp (cdr x)))
          (set-cdr! x y)
          (loop temp x))))
  (loop x '()))

Loop uses the ``temporary'' variable temp to hold the old value of the cdr of x, since the set-cdr! on the next line destroys the cdr. Explain what mystery does in general. Suppose v is defined by (define v (list 'a 'b 'c 'd)). Draw the box-and-pointer diagram that represents the list to which v is bound. Suppose that we now evaluate (define w (mystery v)). Draw box-and-pointer diagrams that show the structures v and w after evaluating this expression. What would be printed as the values of v and w ?

---

作者: win_hate    时间: 2008-12-13 10:54
标题: Exercise 3.14. 答案

• mystery 作用在一个列表上，它遍历并反转此列表
  
• 部分反转的列表在 y 中积累。
  
• (define w (mystery v)) 后，w 为 (d c b a)，而 v 是 (a)
  
  v 在第一次循环中被肢解成两部分。一部分是 temp = (cdr v)，用在以后的循环中，另一部分是: v 的第一个 cons 的右指针指向 y，此时它是个空表。所以 v 为 (a). 此后的循环与 v 再无关系，所以最后 v 任是 (a).
  

---

作者: win_hate    时间: 2008-12-14 11:36
标题: Exercise 3.15.
Exercise 3.15.  Draw box-and-pointer diagrams to explain the effect of set-to-wow! on the structures z1 and z2 above.

---

作者: win_hate    时间: 2008-12-14 11:36
标题: Exercise 3.15. 答案
<wait: pic>

---

作者: win_hate    时间: 2008-12-14 11:37
标题: Exercise 3.16.
Exercise 3.16.  Ben Bitdiddle decides to write a procedure to count the number of pairs in any list structure. ``It's easy,'' he reasons. ``The number of pairs in any structure is the number in the car plus the number in the cdr plus one more to count the current pair.'' So Ben writes the following procedure:

(define (count-pairs x)
  (if (not (pair? x))
      0
      (+ (count-pairs (car x))
         (count-pairs (cdr x))
         1)))

Show that this procedure is not correct. In particular, draw box-and-pointer diagrams representing list structures made up of exactly three pairs for which Ben's procedure would return 3; return 4; return 7; never return at all.

---

作者: win_hate    时间: 2008-12-14 11:40
标题: Exercise 3.16. 答案
造成计数混乱的原因是数据中有共享部分，这些共享部分被重复计算。

1. 
   
2. (define s3 (cons (cons 1 2) (cons 3 4)))
   
3. 
   
4. (define a (cons 2 3))
   
5. (define b (cons a a))
   
6. (define s4 (cons 1 b))
   
7. (define s7 (cons b b))
   

复制代码

测试

1. 
   
2. > (load "3.16.scm")
   
3. 
   
4. > (count-pairs s3)
   
5. 3
   
6. 
   
7. > (count-pairs s4)
   
8. 4
   
9. 
   
10. > (count-pairs s7)
    
11. 7
    

复制代码

---

作者: win_hate    时间: 2008-12-14 12:20
标题: Exercise 3.17.
Exercise 3.17.  Devise a correct version of the count-pairs procedure of exercise 3.16 that returns the number of distinct pairs in any structure. (Hint: Traverse the structure, maintaining an auxiliary data structure that is used to keep track of which pairs have already been counted.)

---

作者: win_hate    时间: 2008-12-14 12:33
标题: Exercise 3.17. 答案
最直接的想法是记住已经访问过的部分。可以把已经访问过的节点（地址）存放在一个 hash 表内。

1. 
   
2. (define (count-pairs x)
   
3.   (let ((table (make-hash-table)))
   
4.     (define (f x)
   
5.       (cond ((not (pair? x)) 0)
   
6.             ((hashq-ref table x) 0)
   
7.             (else  (hashq-set! table x #t)
   
8.                    (+ (f (car x)) (f (cdr x)) 1))))
   
9.     (f x)))
   

复制代码

这里的 make-hash-table 是 guile 里提供的. 哈希表不是 scheme 的标准组成部分，所以不同的 shceme 中的 hash 接口并不一致。

测试

1. 
   
2. > (load "3.16.scm")
   
3. > (load "3.17.scm")
   
4. 
   
5. > (count-pairs s3)
   
6. 3
   
7. 
   
8. > (count-pairs s4)
   
9. 3
   
10. 
    
11. > (count-pairs s7)
    
12. 3
    

复制代码

如果用 3.13 中的 make-cycle 生成一个循环列表，则 3.16 中的 count-pairs 不会返回，而这里的 count-pairs 能返回。

1. 
   
2. > (define x (make-cycle (list 1 2 3 4 5 6 7)))
   
3. 
   
4. > (count-pairs x)
   
5. 7
   
6. 
   
7. > (define y (make-cycle (list 1 1 1 1 1 1 1)))
   
8. 
   
9. > (count-pairs x)
   
10. 7
    

复制代码

[ 本帖最后由 win_hate 于 2008-12-14 12:42 编辑 ]

---

作者: win_hate    时间: 2008-12-14 12:43
标题: Exercise 3.18.
Exercise 3.18.  Write a procedure that examines a list and determines whether it contains a cycle, that is, whether a program that tried to find the end of the list by taking successive cdrs would go into an infinite loop. Exercise 3.13 constructed such lists.

---

作者: win_hate    时间: 2008-12-14 12:44
标题: Exercise 3.18. 答案
跟上一题类似的思路

1. 
   
2. (define (check-cycle xs)
   
3.   (let ((table (make-hash-table)))
   
4.     (define (f ys)
   
5.       (cond ((null? ys) '#f)
   
6.             ((hashq-ref table ys) '#t)
   
7.             (else (hashq-set! table ys #t)
   
8.                   (f (cdr ys)))))
   
9.     (f xs)))
   

复制代码

测试

1. 
   
2. > (load "3.13.scm")
   
3. > (load "3.18.scm")
   
4. 
   
5. > (define x (make-cycle (list 1 2 3 4 5 6 7)))
   
6. > (check-cycle x)
   
7. #t
   
8. 
   
9. > (define y (make-cycle (list 1 1 1 1 1 1 1)))
   
10. > (check-cycle y)
    
11. #t
    
12. 
    
13. > (define z (list 1 2 3 4 5 6 7))
    
14. > (check-cycle z)
    
15. #f
    

复制代码

[ 本帖最后由 win_hate 于 2008-12-14 12:46 编辑 ]

---

作者: win_hate    时间: 2008-12-14 12:49
标题: Exercise 3.19.
Exercise 3.19.  Redo exercise 3.18 using an algorithm that takes only a constant amount of space. (This requires a very clever idea.)

---

作者: win_hate    时间: 2008-12-14 13:18
标题: Exercise 3.19. 答案

1. 
   
2. (define (check-cycle xs)
   
3.   (define (f s1 s2)
   
4.     (cond ((null? s2) #f)
   
5.           ((eq? s1 s2) #t)
   
6.           ((null? (cdr s2)) #f)
   
7.           (else (f (cdr s1) (cddr s2)))))
   
8.            
   
9.   (cond ((null? xs) #f)
   
10.         ((null? (cdr xs)) #f)
    
11.         (else (f xs (cddr xs)))))
    

复制代码

解释：

• 从列表 X 的第一个节点起编号，记为 X(0), X(1), X(2) .... 如果 X 中含有一个环，则 X(n) 的下标 n 可无限增大。
  
• 可以用 eq? 来判断 X(i), X(j) 是否同一个节点。
  
• 具体做法为：选取 {X(i)} 的一个子列 {X(2i)}，不断地用 eq? 比较 X(i) 与 X(2i)。如果子列 X(2i) 在前移中碰到表尾(NIL)，则表明没有环。如果 X(2i) 没碰到表尾，发现某个 i 使 X(i) 与 X(2i) 是同一个点，则表明有环。在有环的情形下，X(2i) 永远不会碰到表尾。
  
• 这个算法一定能发现环。
  
  设有环且环的大小为 b, 则 X(i) 与 X(2i) 重合等价与 i=2i (mod b) => i=0 (mod b)。环中只有一个节点下标是 b 的倍数，当 X(i) 达到这个节点时，就能发现环。
  
• 这个算法的时间复杂度是 O(n)，空间复杂度为 O(1)
  
  

关于这个题目，在 CU 上有更深入一些的讨论，请参考

• 有什么简单的办法检查单链表里是否有环？
  
• 一个关于单向链表的面试题
  

[ 本帖最后由 win_hate 于 2008-12-14 13:30 编辑 ]

---

作者: win_hate    时间: 2008-12-19 20:31
标题: Exercise 3.20.
Exercise 3.20.  Draw environment diagrams to illustrate the evaluation of the sequence of expressions

(define x (cons 1 2))
(define z (cons x x))
(set-car! (cdr z) 17)
(car x)
17

using the procedural implementation of pairs given above. (Compare exercise 3.11.)

---

作者: win_hate    时间: 2008-12-19 20:32
标题: Exercise 3.20. 答案
<wait for pic>

---

作者: win_hate    时间: 2008-12-19 20:33
标题: Exercise 3.21.
Exercise 3.21.  Ben Bitdiddle decides to test the queue implementation described above. He types in the procedures to the Lisp interpreter and proceeds to try them out:

(define q1 (make-queue))
(insert-queue! q1 'a)
((a) a)
(insert-queue! q1 'b)
((a b) b)
(delete-queue! q1)
((b) b)
(delete-queue! q1)
(() b)

``It's all wrong!'' he complains. ``The interpreter's response shows that the last item is inserted into the queue twice. And when I delete both items, the second b is still there, so the queue isn't empty, even though it's supposed to be.'' Eva Lu Ator suggests that Ben has misunderstood what is happening. ``It's not that the items are going into the queue twice,'' she explains. ``It's just that the standard Lisp printer doesn't know how to make sense of the queue representation. If you want to see the queue printed correctly, you'll have to define your own print procedure for queues.'' Explain what Eva Lu is talking about. In particular, show why Ben's examples produce the printed results that they do. Define a procedure print-queue that takes a queue as input and prints the sequence of items in the queue.

---

作者: win_hate    时间: 2008-12-19 20:39
标题: Exercise 3.21. 答案
由于 queue 结构在最顶端是两个指针，即一个 cons。第一个指针指向队列头，所以打印出整个队列，第二个指针指向队列尾，所以只打印出队列的最后一项。

1. 
   
2. (define (print-queue queue)
   
3.   (display (front-ptr queue))
   
4.   (newline))
   

复制代码

演示

1. 
   
2. > (define Q (make-queue))
   
3. 
   
4. > (insert-queue! Q 'a)
   
5. ((a) a)
   
6. 
   
7. > (insert-queue! Q 'b)
   
8. ((a b) b)
   
9. 
   
10. > (insert-queue! Q 'c)
    
11. ((a b c) c)
    
12. 
    
13. > (print-queue Q)
    
14. (a b c)
    
15. 
    
16. > (delete-queue! Q)
    
17. ((b c) c)
    
18. 
    
19. > (print-queue Q)
    
20. (b c)
    

复制代码

---

作者: win_hate    时间: 2008-12-19 20:40
标题: Exercise 3.22.
Exercise 3.22.  Instead of representing a queue as a pair of pointers, we can build a queue as a procedure with local state. The local state will consist of pointers to the beginning and the end of an ordinary list. Thus, the make-queue procedure will have the form

(define (make-queue)
  (let ((front-ptr ...)
        (rear-ptr ...))
    <definitions of internal procedures>
    (define (dispatch m) ...)
    dispatch))

Complete the definition of make-queue and provide implementations of the queue operations using this representation.

---

作者: win_hate    时间: 2008-12-19 20:48
标题: Exercise 3.22. 答案

1. 
   
2. (define (make-queue)
   
3.   (let ((front-ptr '())
   
4.         (rear-ptr '()))
   
5. 
   
6.     (define (empty-queue?)
   
7.       (eq? front-ptr '()))
   
8.    
   
9.     (define (insert-queue item)
   
10.       (cond ((empty-queue?)
    
11.              (set! front-ptr item)
    
12.              (set! rear-ptr item))
    
13.             (else
    
14.              (set-cdr! rear-ptr item)
    
15.              (set! rear-ptr item))))
    
16. 
    
17.     (define (delete-queue)
    
18.       (cond ((empty-queue?)
    
19.              (error "DELETE! called with an empty queue"))
    
20.             (else
    
21.              (set! front-ptr (cdr front-ptr)))))
    
22.    
    
23.     (define (front-queue)
    
24.       (if (empty-queue?)
    
25.           (error "FRONT called with an empty queue")
    
26.           (car front-ptr)))
    
27. 
    
28.     (define (dispatch m . z)
    
29.       (cond ((eq? m 'front-ptr) front-ptr)
    
30.             ((eq? m 'rear-ptr) rear-ptr)
    
31.             ((eq? m 'empty?) (empty-queue?))
    
32.             ((eq? m 'front) (front-queue))
    
33.             ((eq? m 'insert) (insert-queue z))
    
34.             ((eq? m 'delete) (delete-queue))
    
35.             (else (error "Unknown command" m))))
    
36.       
    
37.   dispatch))
    

复制代码

演示

1. 
   
2. > (define Q (make-queue))
   
3. 
   
4. > (Q 'empty?)
   
5. #t
   
6. 
   
7. > (Q 'print)
   
8. ()
   
9. 
   
10. > (Q 'insert 'a)
    
11. 
    
12. > (Q 'empty?)
    
13. #f
    
14. 
    
15. > (Q 'insert 'b)
    
16. > (Q 'insert 'c)
    
17. 
    
18. > (Q 'front)
    
19. a
    
20. 
    
21. > (Q 'print)
    
22. (a b c)
    
23. 
    
24. > (Q 'delete)
    
25. 
    
26. > (Q 'print)
    
27. (b c)
    

复制代码

---

作者: win_hate    时间: 2008-12-20 11:34
标题: Exercise 3.23.
Exercise 3.23.  A deque (``double-ended queue'') is a sequence in which items can be inserted and deleted at either the front or the rear. Operations on deques are the constructor make-deque, the predicate empty-deque?, selectors front-deque and rear-deque, and mutators front-insert-deque!, rear-insert-deque!, front-delete-deque!, and rear-delete-deque!. Show how to represent deques using pairs, and give implementations of the operations.23 All operations should be accomplished in O(1) steps.

---

作者: win_hate    时间: 2008-12-20 12:03
标题: Exercise 3.23. 答案
前面的队列使用了一个单链表：


改成双向的。

1. 
   
2. (define (front-ptr deque) (car deque))
   
3. 
   
4. (define (rear-ptr deque) (cdr deque))
   
5. 
   
6. (define (set-front-ptr! deque item)
   
7.   (set-car! deque item))
   
8. 
   
9. (define (set-rear-ptr! deque item)
   
10.   (set-cdr! deque item))
    
11. 
    
12. (define (empty-deque? deque)
    
13.   (null? (front-ptr deque)))
    
14. 
    
15. (define (make-deque) (cons '() '()))
    
16. 
    
17. (define (front-deque deque)
    
18.   (if (empty-deque? deque)
    
19.       (error "FRONT called with an empty deque" deque)
    
20.       (caar (front-ptr deque))))
    
21. 
    
22. (define (rear-deque deque)
    
23.   (if (empty-deque? deque)
    
24.       (error "REAR called with an empty deque" deque)
    
25.       (caar (rear-ptr deque))))
    
26. 
    
27. (define (rear-insert-deque! deque item)
    
28.   (let ((new-pair (cons (cons item '()) '())))
    
29.     (cond ((empty-deque? deque)
    
30.            (set-front-ptr! deque new-pair)
    
31.            (set-rear-ptr! deque new-pair))
    
32.           (else
    
33.            (set-cdr! (rear-ptr deque) new-pair)
    
34.            (set-cdr! (car new-pair) (rear-ptr deque))
    
35.            (set-rear-ptr! deque new-pair)))))
    
36. 
    
37. (define (front-insert-deque! deque item)
    
38.   (let ((new-pair (cons (cons item '()) '())))
    
39.     (cond ((empty-deque? deque)
    
40.            (set-front-ptr! deque new-pair)
    
41.            (set-rear-ptr! deque new-pair))
    
42.           (else
    
43.            (set-cdr! new-pair (front-ptr deque))
    
44.            (set-cdr! (cadr new-pair) new-pair)
    
45.            (set-front-ptr! deque new-pair)))))
    
46. 
    
47. (define (print-deque deque)
    
48.   (let ((rear (rear-ptr deque)))
    
49.     (define (f xs)
    
50.       (cond ((eq? xs rear)
    
51.              (display (caar xs))
    
52.              (display " "))
    
53.             (else
    
54.              (display (caar xs))
    
55.              (display " ")
    
56.              (f (cdr xs)))))
    
57.     (if (empty-deque? deque)
    
58.         (display "empty deque\n")
    
59.         (f (front-ptr deque)))))
    
60. 
    
61. (define (front-delete-deque! deque)
    
62.   (cond ((empty-deque? deque)
    
63.          (error "Delete called with empty deque" deque))
    
64.         ((eq? (front-ptr deque)
    
65.               (rear-ptr deque))
    
66.          (set-front-ptr! deque '())
    
67.          (set-rear-ptr! deque '()))
    
68.         (else
    
69.          (set-front-ptr! deque (cdr (front-ptr deque)))
    
70.          (set-cdr! (car (front-ptr deque)) '()))))
    
71. 
    
72. (define (rear-delete-deque! deque)
    
73.   (cond ((empty-deque? deque)
    
74.          (error "Delete called with empty deque" deque))
    
75.         ((eq? (front-ptr deque)
    
76.               (rear-ptr deque))
    
77.          (set-front-ptr! deque '())
    
78.          (set-rear-ptr! deque '()))
    
79.         (else
    
80.          (set-rear-ptr! deque (cdar (rear-ptr deque)))
    
81.          (set-cdr! (rear-ptr deque) '()))))
    

复制代码

演示

1. 
   
2. > (define dq (make-deque))
   
3. 
   
4. > (empty-deque? dq)
   
5. #t
   
6. 
   
7. > (rear-insert-deque! dq 'a)
   
8. > (empty-deque? dq)
   
9. #f
   
10. 
    
11. > (rear-insert-deque! dq 'b)
    
12. > (rear-insert-deque! dq 'c)
    
13. > (print-deque dq)
    
14. a b c
    
15. 
    
16. > (front-insert-deque! dq 'A)
    
17. > (front-insert-deque! dq 'B)
    
18. > (front-insert-deque! dq 'C)
    
19. > (print-deque dq)
    
20. C B A a b c
    
21. 
    
22. > (rear-delete-deque! dq)
    
23. > (print-deque dq)
    
24. C B A a b
    
25. 
    
26. > (front-delete-deque! dq)
    
27. > (print-deque dq)
    
28. B A a b
    

复制代码

---

作者: win_hate    时间: 2008-12-21 10:35
标题: Exercise 3.24.
Exercise 3.24.  In the table implementations above, the keys are tested for equality using equal? (called by assoc). This is not always the appropriate test. For instance, we might have a table with numeric keys in which we don't need an exact match to the number we're looking up, but only a number within some tolerance of it. Design a table constructor make-table that takes as an argument a same-key? procedure that will be used to test ``equality'' of keys. Make-table should return a dispatch procedure that can be used to access appropriate lookup and insert! procedures for a local table.

---

作者: win_hate    时间: 2008-12-21 10:42
标题: Exercise 3.24. 答案

1. 
   
2. (define (make-table cmp)
   
3.   (let ((local-table (list '*table*)))
   
4.     (define (assoc key records cmp)
   
5.       (cond ((null? records) #f)
   
6.             ((cmp key (caar records)) (car records))
   
7.             (else (assoc key (cdr records) cmp))))
   
8.    
   
9.     (define (lookup key1 key2)
   
10.       (let ((subtable (assoc key1 (cdr local-table) cmp)))
    
11.         (if subtable
    
12.             (let ((record (assoc key2 (cdr subtable) cmp)))
    
13.               (if record
    
14.                   (cdr record)
    
15.                   #f))
    
16.             #f)))
    
17. 
    
18.     (define (insert! key1 key2 value)
    
19.       (let ((subtable (assoc key1 (cdr local-table) cmp)))
    
20.         (if subtable
    
21.             (let ((record (assoc key2 (cdr subtable) cmp)))
    
22.               (if record
    
23.                   (set-cdr! record value)
    
24.                   (set-cdr! subtable
    
25.                             (cons (cons key2 value)
    
26.                                   (cdr subtable)))))
    
27.             (set-cdr! local-table
    
28.                       (cons (list key1
    
29.                                   (cons key2 value))
    
30.                             (cdr local-table)))))
    
31.         'ok)
    
32. 
    
33.       (define (dispatch m)
    
34.         (cond ((eq? m 'lookup-proc) lookup)
    
35.               ((eq? m 'insert-proc!) insert!)
    
36.               (else (error "Unknown operation -- TABLE" m))))
    
37.       dispatch))
    
38.             
    
39. 
    
40. (define (cmp x y)
    
41.   (< (abs (- x y)) 0.5))
    

复制代码

演示

1. 
   
2. > (define tb (make-table cmp))
   
3. > (define get (tb 'lookup-proc))
   
4. > (define put (tb 'insert-proc!))
   
5. 
   
6. > (get 1.2 2.3)
   
7. #f
   
8. 
   
9. > (put 1 2 3)
   
10. ok
    
11. 
    
12. > (get 1.2 2.3)
    
13. 3
    

复制代码

---

作者: win_hate    时间: 2008-12-21 10:44
标题: Exercise 3.25.
Exercise 3.25.  Generalizing one- and two-dimensional tables, show how to implement a table in which values are stored under an arbitrary number of keys and different values may be stored under different numbers of keys. The lookup and insert! procedures should take as input a list of keys used to access the table.

---

作者: win_hate    时间: 2008-12-21 11:23
标题: Exercise 3.25. 答案
思路

• 多重键值的处理
  
  一个直接的思路是递归处理键值。例如，'a, 'b, 'c 键值对应 1，则 'a 键值下有一个 assoc 表，其中一项键值为 'b，其下又有一个 assoc 表，里头有一项为 (c . 1).
  
  当插入键值时，首先 lookup，如果失败，这创建要插入的内容，插入到合适的位置上。由于是多重键值，比如 ('a 'b 'c)，lookup 失败可能发生在 'a，也可能发生在 'b，也可能发生在 'c，所示失败时只返回一个 #f 是不够的。lookup 在失败时的返回值应该包括失败标志，剩余的 key，插入位置。但这样的接口又使得 lookup 很难用。为此，我添加了一个叫 locate 的函数来处理这些繁琐的事情，而 insert!, lookup 都调用 locate，从而能保持简洁的接口。
  
  
• 不同长度键值带来的问题
  
  但题目要求，两个值可以有不同长度的键列。比如 ('a) ->1, ('a 'b) -> 2。这样会带来一个问题。如果表中包含前者，则键 'a 对应的值为 1,即
  
  ('a . 1)
  
  但如果是后者，则 'a 对应的值是一个 assoc list，在这个 list 中，有一项 ('b . 1)。
  
  这两种情况是互斥的，会相互覆盖。如果先插入  'a -> 1，则再插入 ('a 'b)->2 时，前一个对应就没有了；反过来也一样。
  
  我采用的方案为：在给定键列尾部附加上一个伪键值 '()，用户的键值序列不允许包含此值。假如要插入 'a ->1 和 ('a 'b) ->2。在采用新方案前，两个键值序列为
  
  'a 和
  
  'a 'b
  
  当插入后面的 'b 时，新插入的 assoc list 会覆盖 'a 右边的值。
  
  采用新方案后，键值序列变为：
  
  'a () 和
  
  'a 'b '()
  
  当插入 'b 时，'a 的右边是个 assoc 表，把 ('b . ...) 插入这个 assoc 即可，不会产生覆盖。
  
  假设当前为空表，那么，当插入 'a->1 时，实际效果为
  
  ( a . ( () . 1)) ,
  
  再插入 ('a 'b) -> 2 时，变为
  
  (a . ( (b (() . 2 )) (() . 1))) .
  
  这个处理使得用户键值右边总是一个 assoc 表，从而简化了逻辑，避免了相互覆盖。
  

1. 
   
2. (define (make-table)
   
3.   (list '*table*))
   
4. 
   
5. (define (assoc key records)
   
6.   (cond ((null? records) #f)
   
7.         ((equal? key (caar records)) (car records))
   
8.         (else (assoc key (cdr records)))))
   
9. 
   
10. (define (locate keys table)
    
11.   (define (find keys records)
    
12.     (if  (null? keys) (cons '() records)
    
13.          (let ((subtable (assoc (car keys) (cdr records))))
    
14.            (if (eq? subtable #f)
    
15.                (cons keys records)
    
16.                (find (cdr keys) subtable)))))
    
17. 
    
18.   (find keys table))
    
19. 
    
20. (define (lookup keys table)
    
21.   (let ((tmp (locate (append keys '(())) table)))
    
22.     (if (null? (car tmp))
    
23.         (cddr tmp)
    
24.         #f)))
    
25.   
    
26. (define (insert! keys value table)  
    
27.   (define (create keys)
    
28.     (if (null? (cdr keys))
    
29.         (cons (car keys) value)
    
30.         (list (car keys) (create (cdr keys)))))
    
31.   
    
32.   (let* ((tmp (locate (append keys '(())) table))
    
33.          (rest-keys (car tmp))
    
34.          (subtable (cdr tmp)))
    
35.     (cond ((null? rest-keys) (set-cdr! subtable))
    
36.           (else
    
37.            (set-cdr! subtable
    
38.                      (cons (create rest-keys) (cdr subtable)))))))
    

复制代码

演示

1. 
   
2. > (define tb (make-table))
   
3. 
   
4. > (lookup '(a b) tb)
   
5. #f
   
6. 
   
7. > (insert! '(a b) 1 tb)
   
8. > (lookup '(a b) tb)
   
9. 1
   
10. 
    
11. > (insert! '(a b c) 2 tb)
    
12. > (lookup '(a b c) tb)
    
13. 2
    
14. > (lookup '(a b) tb)
    
15. 1
    
16. 
    
17. > (insert! '(a) 1 tb)
    
18. > (lookup '(a) tb)
    
19. 1
    
20. > (lookup '(a b) tb)
    
21. 1
    
22. > (lookup '(a b c) tb)
    
23. 2
    
24. 
    
25. > (insert! '(d e f g h) 1000 tb)
    
26. > (lookup '(d e f g h) tb)
    
27. 1000
    
28. > (lookup '(d e f) tb)
    
29. #f
    

复制代码

[ 本帖最后由 win_hate 于 2008-12-21 11:25 编辑 ]

---

作者: win_hate    时间: 2008-12-22 17:52
标题: Exercise 3.26.
Exercise 3.26.  To search a table as implemented above, one needs to scan through the list of records. This is basically the unordered list representation of section 2.3.3. For large tables, it may be more efficient to structure the table in a different manner. Describe a table implementation where the (key, value) records are organized using a binary tree, assuming that keys can be ordered in some way (e.g., numerically or alphabetically). (Compare exercise 2.66 of chapter 2.)

---

作者: win_hate    时间: 2008-12-22 17:53
没兴趣，这个题目以后做。

后面的一些题目要有趣得多。

---

作者: win_hate    时间: 2008-12-22 17:54
标题: Exercise 2.27.
Exercise 3.27.  Memoization (also called tabulation) is a technique that enables a procedure to record, in a local table, values that have previously been computed. This technique can make a vast difference in the performance of a program. A memoized procedure maintains a table in which values of previous calls are stored using as keys the arguments that produced the values. When the memoized procedure is asked to compute a value, it first checks the table to see if the value is already there and, if so, just returns that value. Otherwise, it computes the new value in the ordinary way and stores this in the table. As an example of memoization, recall from section 1.2.2 the exponential process for computing Fibonacci numbers:

(define (fib n)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib (- n 1))
                 (fib (- n 2))))))

The memoized version of the same procedure is

(define memo-fib
  (memoize (lambda (n)
             (cond ((= n 0) 0)
                   ((= n 1) 1)
                   (else (+ (memo-fib (- n 1))
                            (memo-fib (- n 2))))))))

where the memoizer is defined as

(define (memoize f)
  (let ((table (make-table)))
    (lambda (x)
      (let ((previously-computed-result (lookup x table)))
        (or previously-computed-result
            (let ((result (f x)))
              (insert! x result table)
              result))))))

Draw an environment diagram to analyze the computation of (memo-fib 3). Explain why memo-fib computes the nth Fibonacci number in a number of steps proportional to n. Would the scheme still work if we had simply defined memo-fib to be (memoize fib)?

---

作者: win_hate    时间: 2008-12-22 18:20
标题: Exercise 3.27. 答案
(memoize f) 返回一个函数，这个函数的参数为自然数。如果 n 对应的函数值（f(n)） 已经在局部表中，则使用表格中的值，避免了计算；如果 n 对应的函数值不存在于表格中，则计算 f(n) 把结果插入到表格中。

f 必须能与 memoize 配合才能提高效率，简单地 (memoize fib) 是不行的。比如

1. 
   
2. (define g (memoize fib))
   

复制代码

假定现在表格中存有 1~n 对应的 fib(n)，在计算 g(n+1) 时，还是会通过 fib (n+1) 来计算， fib 对表格一无所知，不断通过自身进行递归，重新计算出表格中已有的数据。

题目的方法比较 'hack'，

• 把 (memoize f) 返回的函数命名为 memo-fib；
  
• f 是一个匿名函数，其中包含对 memo-fib 的调用。
  
  

这样实际上造出了 memo-fib 通过自身的递归，而它会查找、修改局部表。

下面是我写的带记忆的 fib 函数，比题目的容易理解多了。

1. 
   
2. (define (make-fib)
   
3.   (let ((table (make-table)))
   
4.     (define (fib n)
   
5.       (let ((t1 (lookup n table)))
   
6.         (if t1 t1
   
7.             (let ((t2 (+ (fib (- n 1))
   
8.                         (fib (- n 2)))))
   
9.               (insert! n t2 table)
   
10.               t2))))
    
11.     (insert! 0 0 table)
    
12.     (insert! 1 1 table)
    
13.     fib))
    

复制代码

这个题目有个有趣的地方，书上没提到－－－这个实现可以计算多大的 fib 值？

1. 
   
2. > (memo-fib 250)
   
3. ERROR: Stack overflow
   
4. ABORT: (stack-overflow)
   

复制代码

oops, 250 项都算不出来。但记忆表已经避免了很多递归啊。

避免递归的前提是记忆表中有足够多的数据。按现在的写法，如果表格是空的，或者只有少量数据，仍可能产生很深的递归。

这样一分析，可以看出，计算大的 n 是可行的，只要先计算一些小的 n.

再来：

1. 
   
2. > (memo-fib 200)
   
3. 280571172992510140037611932413038677189525
   
4. 
   
5. > (memo-fib 400)
   
6. 176023680645013966468226945392411250770384383304492191886725992896575345044216019675
   
7. 
   
8. > (memo-fib 600)
   
9. 110433070572952242346432246767718285942590237357555606380008891875277701705731473925618404421867819924194229142447517901959200
   
10. 
    
11. > (memo-fib 800)
    
12. 69283081864224717136290077681328518273399124385204820718966040597691435587278383112277161967532530675374170857404743017623467220361778016172106855838975759985190398725
    
13. 
    
14. > (memo-fib 1000)
    
15. 43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875
    
16. 
    
17. > (memo-fib 1500)
    
18. ERROR: Stack overflow
    
19. ABORT: (stack-overflow)
    
20. 
    
21. > (memo-fib 1200)
    
22. 27269884455406270157991615313642198705000779992917725821180502894974726476373026809482509284562310031170172380127627214493597616743856443016039972205847405917634660750474914561879656763268658528092195715626073248224067794253809132219056382939163918400
    
23. 
    
24. > (memo-fib 1500)
    
25. ERROR: Stack overflow
    
26. ABORT: (stack-overflow)
    
27. 
    
28. > (memo-fib 1400)
    
29. 17108476902340227241249719513231821477382749898026920041550883749834348017250935801359315038923367841494936038231522506358371361016671790887791259870264957823133253627917432203111969704623229384763490617075388642696139893354058660570399927047816296952516330636633851111646387885472698683607925
    
30. 
    
31. > (memo-fib 1600)
    
32. 10733451489189611103121609043038710477166925241925645413424099370355605456852169736033991876014762808340865848447476173426115162172818890323837138136782951865054538417494035229785971002587932638902311416018904156170269354720460896363558168129004231138415225204738582550720791061581463934092726107458349298577292984375276210232582438075
    

复制代码

最后，如果初始表是空的，计算 (memo-fib n) 的递归深度是 n，‘宽度’ 是 2，所以是 O(n) 的。

[ 本帖最后由 win_hate 于 2008-12-22 18:39 编辑 ]

---

作者: win_hate    时间: 2008-12-26 23:25
标题: Exercise 3.28.
Exercise 3.28.  Define an or-gate as a primitive function box. Your or-gate constructor should be similar to and-gate.

---

作者: win_hate    时间: 2008-12-26 23:27
标题: Exercise 3.28. 答案

1. 
   
2. (define (or-gate a1 a2 output)
   
3.   (define (or-action-procedure)
   
4.     (let ((new-value
   
5.            (logical-or (get-signal a1) (get-signal a2))))
   
6.       (after-delay or-gate-delay
   
7.                    (lambda ()
   
8.                      (set-signal! output new-value)))))
   
9.   (add-action! a1 or-action-procedure)
   
10.   (add-action! a2 or-action-procedure)
    
11.   'ok)
    

复制代码

演示

1. 
   
2. (define a (make-wire))
   
3. (define b (make-wire))
   
4. (define c (make-wire))
   
5. (or-gate a b c)
   
6. (set-signal! a 1)
   
7. (set-signal! b 0)
   
8. (probe 'a a)
   
9. (probe 'b b)
   
10. (probe 'c c)
    
11. (propagate)
    

复制代码

输出：

1. 
   
2. a 0 New-value = 1
   
3. b 0 New-value = 0
   
4. c 0 New-value = 0
   
5. c 5 New-value = 1
   

复制代码

注意这里的代码需要整个电路包，必须把整节代码完成后，才能运行。

[ 本帖最后由 win_hate 于 2008-12-26 23:40 编辑 ]

---

作者: win_hate    时间: 2008-12-26 23:27
标题: Exercise 3.29.
Exercise 3.29.  Another way to construct an or-gate is as a compound digital logic device, built from and-gates and inverters. Define a procedure or-gate that accomplishes this. What is the delay time of the or-gate in terms of and-gate-delay and inverter-delay?

---

作者: win_hate    时间: 2008-12-26 23:28
标题: Exercise 3.29. 答案

1. 
   
2. (define (my-or-gate a1 a2 output)
   
3.   (let ((b1 (make-wire))
   
4.         (b2 (make-wire))
   
5.         (c (make-wire)))
   
6.     (inverter a1 b1)
   
7.     (inverter a2 b2)
   
8.     (and-gate b1 b2 c)
   
9.     (inverter c output)
   
10.   'ok))
    

复制代码

演示

1. 
   
2. (define a (make-wire))
   
3. define b (make-wire))
   
4. (define c (make-wire))
   
5. (my-or-gate a b c)
   
6. (set-signal! a 1)
   
7. (set-signal! b 0)
   
8. (probe 'a a)
   
9. (probe 'b b)
   
10. (probe 'c c)
    
11. (propagate)
    

复制代码

1. 
   
2. a 0 New-value = 1
   
3. b 0 New-value = 0
   
4. c 0 New-value = 0
   
5. c 2 New-value = 1
   
6. c 7 New-value = 0
   
7. c 7 New-value = 1
   

复制代码

注意 c 在时刻 2 变成了 1。 这是因为 make-wire 得到的线初始值为 0，所以整个系统一般并不处于稳定状态。比如一开始，内部的 c 和外部的 c(接口中的 output) 都是 0，所以在时刻 2，外部的 c 变为 1。

另外，这个 or-gate 不是原生的，而是利用 inverter 和 and-gate 搭起来的，所以延时跟 3.28 中的不一样。3.28 中那个延时是指定的。

[ 本帖最后由 win_hate 于 2008-12-27 16:19 编辑 ]

---

作者: win_hate    时间: 2008-12-27 16:14
标题: Exercise 3.30.
Exercise 3.30.  Figure 3.27 shows a ripple-carry adder formed by stringing together n full-adders. This is the simplest form of parallel adder for adding two n-bit binary numbers. The inputs A1, A2, A3, ..., An and B1, B2, B3, ..., Bn are the two binary numbers to be added (each Ak and Bk is a 0 or a 1). The circuit generates S1, S2, S3, ..., Sn, the n bits of the sum, and C, the carry from the addition. Write a procedure ripple-carry-adder that generates this circuit. The procedure should take as arguments three lists of n wires each -- the Ak, the Bk, and the Sk -- and also another wire C. The major drawback of the ripple-carry adder is the need to wait for the carry signals to propagate. What is the delay needed to obtain the complete output from an n-bit ripple-carry adder, expressed in terms of the delays for and-gates, or-gates, and inverters?


Figure 3.27:  A ripple-carry adder for n-bit numbers.

---

作者: win_hate    时间: 2008-12-27 16:17
标题: Exercise 3.30. 答案 (上)

1. 
   
2. (define (full-adder A B Ci S Co)
   
3.   (let ((tmp (make-wire))
   
4.         (or1 (make-wire))
   
5.         (or2 (make-wire)))
   
6.     (half-adder B Ci tmp or2)
   
7.     (half-adder A tmp S or1)
   
8.     (or-gate or1 or2 Co)
   
9.     'ok))
   
10.         
    
11. (define (ripple-carry-adder A B S C)
    
12.   (define (f A B S last-c)
    
13.     (if (null? (cdr A))
    
14.         (full-adder (car A) (car B) last-c
    
15.                     (car S) C)
    
16.         (let ((c (make-wire)))
    
17.           (full-adder (car A) (car B) last-c
    
18.                       (car S) c)
    
19.           (f (cdr A) (cdr B) (cdr S) c))))
    
20.   (let ((c (make-wire)))
    
21.     (f A B S c)))
    
22. 
    
23. (define (make-wires n)
    
24.   (if (= n 0) '()
    
25.       (cons (make-wire) (make-wires (- n 1)))))
    
26. 
    
27. (define (set-signals! ws vs)
    
28.   (cond ((not (null? ws))
    
29.          (set-signal! (car ws) (car vs))
    
30.          (set-signals! (cdr ws) (cdr vs)))))
    
31. 
    
32. (define (get-signals ws)
    
33.   (if (null? ws) '()
    
34.       (cons (get-signal (car ws))
    
35.             (get-signals (cdr ws)))))
    
36. 
    
37. (define (probe-signals ws symb n)
    
38.   (cond ((null? ws) 'ok)
    
39.         (else
    
40.          (probe (cons n symb) (car ws))
    
41.          (probe-signal (cdr ws) symb (- n 1)))))
    

复制代码

演示代码：

1. 
   
2. (define A (make-wires 7))
   
3. (define B (make-wires 7))
   
4. (define S (make-wires 7))
   
5. (define c (make-wire))
   
6. (set-signals! A '(1 1 1 1 1 1 1))
   
7. (set-signals! B '(1 1 1 1 1 1 1))
   
8. (ripple-carry-adder A B S c)
   

复制代码

演示输出：

1. 
   
2. guile> (propagate)
   
3. done
   
4. guile> (get-signals A)
   
5. (1 1 1 1 1 1 1)
   
6. guile> (get-signals B)
   
7. (1 1 1 1 1 1 1)
   
8. guile> (get-signals S)
   
9. (0 1 1 1 1 1 1)
   
10. guile> (get-signal c)
    
11. 1
    

复制代码

[ 本帖最后由 win_hate 于 2008-12-27 16:26 编辑 ]

---

作者: win_hate    时间: 2008-12-27 16:23
标题: Exercise 3.30. 答案 (中)
现在讨论延时。把或门，与门，反转器的延迟记为 or, and 和 inv.

• 半加器：
  
  两个输入：A, B
  两个输出：S, C
  
  A->S 的时延为：
  
  max(or, and+inv)+and
  
  A-> C 的时延为:
  
  and
  
  B-> S
  
  max(or, and+inv)+and
  
  B-> C 时延为：
  
  and
  
  所以无论那一个输入发生变化，半加器的输出 s 的延迟为
  
  dhs=max(or, and+inv)+and
  
  半加器的输出 c 的延迟为:
  
  dhc= and
  
• 全加器：
  
  有三个输入 A, B, C(in)，两个输出 SUM, C(out)
  
  A -> SUM：dhs
  
  A-> C(out): dhc+or
  
  B -> SUM: 2 dhs
  
  B -> C(out): max(dhs+dhc, hdc)+or = dhs+hdc+or
  
  C(in) -> SUM: 2 dhs
  
  C(in) -> C(out): max(dhs+dhc, dhc)+or= dhs+dhc+or
  
  SUM 的延迟为 dfs=2dhs, C(out) 的延迟为：dfc=dhs+dhc+or
  
• ripple-carry-adder:
  
  C 的延迟为：n(dfc)
  S1 的延迟为：(n-1)dfc+dfs
  

按书本的设置：or=5, and=3, inv=2

有 dhs=max(or, and+inv)+and=max(5, 5)+3=8
dhc=and=3

dfs = 2dhs = 16
dfc = dhs+dhc+or=8+3+5=16

所以 C 的延迟为 16n, S1 的延迟为 16(n-1)+16=16n

这个只是理论上的最大延迟，但实际未必会达到。比如两个数相加，如果根本没有进位，就不会有进位带来的延迟，大小为 16 的时延就足够了。

[ 本帖最后由 win_hate 于 2008-12-27 16:27 编辑 ]

---

作者: win_hate    时间: 2008-12-27 16:57
标题: Exercise 3.30. 答案 (下)
下面我们看一个具体的例子。用 probe 函数测试实际延迟，并手工计算延迟进行对比。

为简明起见，这里 ripple-carry-adder 的输入设置为两个比特。前面提到过，初始系统是不稳定的，分析起来很罗唆。所以我先用 (0 0) 跟 (1 1) 加一次。最后的结果是稳定的。此时设置时刻为 0，然后把 (0 0) 改为 (1 0)，这样将从最低位引发一个进位，并传播到最终进位上。

代码

1. 
   
2. (define A (make-wires 2))
   
3. (define B (make-wires 2))
   
4. (define S (make-wires 2))
   
5. (define c (make-wire))
   
6. (set-signals! A '(0 0))
   
7. (set-signals! B '(1 1))
   
8. 
   
9. 
   
10. (ripple-carry-adder A B S c)
    
11. (propagate)
    
12. 
    
13. (set-car! the-agenda 0)
    
14. 
    
15. (set-signals! A '(1 0))
    
16. (probe 'c c)
    
17. (probe 's1 (cadr S))
    
18. (propagate)
    

复制代码

输出：

1. 
   
2. c 0 New-value = 0
   
3. s1 0 New-value = 1
   
4. 
   
5. c 16 New-value = 1
   
6. s1 24 New-value = 0
   

复制代码

前两行是第一次 propagate 后 c, s1 的状态。此时系统是稳定的。

把 A 设置为 (1 0) 后，计算结果为 (1 0) + (1 1) = (0 0 1)  ;; 左边是最低位

c 在时刻 16 稳定为 1， 而 s1 在时刻 24 稳定为 0



c 和 s1 见上面的图。由于此时是两比特加两比特，所以上图中 n 为 2，s2 是最低位。

在时刻 0， A2 变为 1，看下面的半加器和全加器。



半加器的 A 在时刻 0 变为 1，所以 C 在时刻 3 改变， S 在时刻 8 改变。后面会看到，S 的改变对我们的分析没有影响。

再看全加器，现在是全加器中上面那个半加器的输出改变了。我们只关心这个全加器的 C(out) ，它在 5 个时刻后，也就是时刻 8 它的值从 0 变为 1。

于是我们看到，在时刻 8， 全加器 s2 产生的进位输出变为 1。

再看下面的半加器和全加器:



半加器的输入 C(in)  在时刻 8 从 0 变为 1。于是在 3 个时刻后，or-gate 靠下方的输入变为 1，5 个时刻后 or-gate 的输出 C(out) 变为 1。
由于 or-gate 有一个输入为 1，所以输出永远为 1，从而其输出稳定下来。这个时刻为 8+3+5=16

那么 SUM 呢？ 在时刻 8, C(in) 从 0 变为 1， 在 8 个时刻后，全加器中靠上的半加器的下方输入发生改变，又过 8 个时刻，SUM 发生改变。稳定时刻为 8+8+8 = 24.

这个分析与实际运行是一致的。

[ 本帖最后由 win_hate 于 2008-12-27 17:54 编辑 ]

---

作者: win_hate    时间: 2008-12-28 14:36
标题: Exercise 3.31.
Exercise 3.31.   The internal procedure accept-action-procedure! defined in make-wire specifies that when a new action procedure is added to a wire, the procedure is immediately run. Explain why this initialization is necessary. In particular, trace through the half-adder example in the paragraphs above and say how the system's response would differ if we had defined accept-action-procedure! as

(define (accept-action-procedure! proc)
  (set! action-procedures (cons proc action-procedures)))

---

作者: win_hate    时间: 2008-12-28 15:36
标题: Exercise 3.31. 答案
如果在 accept-action-procedure! 时不马上把函数执行一次(其实是插入 the-agenda 表)，则这个函数只被放进了线(wire)的函数列表，没有被放到 the-agenda 中。直到此线上信号改变时，这些函数才被插入到 the-agenda 中，排期执行。这会使整个系统中存在错误状态。以最简单的 inverter 为例，它对应的代码为：

1. 
   
2. (define (inverter input output)
   
3.   (define (invert-input)
   
4.     (let ((new-value (logical-not (get-signal input))))
   
5.       (after-delay inverter-delay
   
6.                    (lambda ()
   
7.                      (set-signal! output new-value)))))
   
8.   (add-action! input invert-input)
   
9.   'ok)
   

复制代码

线的初始值都是 0， 那么这个 inverter 的输入、输出都是 0，显然是不对的。如果 add-actions! 的时候把 invert-input 放到 the-agenda 中排队，那么两个时刻后，这个 inverter 的输入、输出就合乎逻辑了。如果 add-actions! 的时候，invert-input 没有马上排期，则 0 反转为 0 的错误状态将一直保持，直到这个 inverter 的输入发生变化才能更正。

书本上半加器的例子：

1. 
   
2. (define input-1 (make-wire))
   
3. (define input-2 (make-wire))
   
4. (define sum (make-wire))
   
5. (define carry (make-wire))
   
6. (probe 'sum sum)
   
7. sum 0  New-value = 0
   
8. (probe 'carry carry)
   
9. carry 0  New-value = 0
   
10. 
    
11. (half-adder input-1 input-2 sum carry)
    
12. ok
    
13. (set-signal! input-1 1)
    
14. done
    
15. (propagate)
    
16. sum 8  New-value = 1
    
17. done
    
18. 
    
19. (set-signal! input-2 1)
    
20. done
    
21. (propagate)
    
22. carry 11  New-value = 1
    
23. sum 16  New-value = 0
    
24. done
    

复制代码

象本题那样把代码改过后，书本上的半加器例子的输出变为：

1. 
   
2. (define input-1 (make-wire))
   
3. (define input-2 (make-wire))
   
4. (define sum (make-wire))
   
5. (define carry (make-wire))
   
6. 
   
7. (probe 'sum sum)
   
8. 
   
9. (probe 'carry carry)
   

复制代码

probe 的时候没有输出，因为对应的函数没有被马上执行。

1. 
   
2. > (half-adder input-1 input-2 sum carry)
   
3. ok
   
4. > (set-signal! input-1 1)
   
5. > (propagate)
   
6. done
   

复制代码

现在半加器的输入是 1， 0，输出是 0，0。这显然是错的。看看下面的半加器



A 变为 1， 这导致最右边的 and-gate 的靠上方的输入为 1，但靠下方的输入呢？ 左边 and-gete 的第一个输入改变为1，导致此 and-gate 的输出我为 0。但由于这个输出初始为 0，所以没有变化。这使得 inverter 的输入没有变化，从而输出也不变！如果当初代码没改动，则 inverter 的输入是会改变的。最终 S 得到一个错误的输出 0.

1. 
   
2. > (set-signal! input-2 1)
   
3. > (propagate)
   
4. carry 11 New-value = 1
   
5. done
   

复制代码

把半加器的 B 也设置为 1，此时 inverter 线上的错误被更正，得到正确的输出 S=0, C=1。但 S 的值没有变化，所以没有相应的 probe 信息。

[ 本帖最后由 win_hate 于 2008-12-29 23:16 编辑 ]

---

作者: win_hate    时间: 2008-12-29 23:16
标题: Exercise 3.32.
Exercise 3.32.  The procedures to be run during each time segment of the agenda are kept in a queue. Thus, the procedures for each segment are called in the order in which they were added to the agenda (first in, first out). Explain why this order must be used. In particular, trace the behavior of an and-gate whose inputs change from 0,1 to 1,0 in the same segment and say how the behavior would differ if we stored a segment's procedures in an ordinary list, adding and removing procedures only at the front (last in, first out).

---

作者: win_hate    时间: 2008-12-29 23:22
标题: Exercise 3.32. 答案
先进先出使得电路上信号的变化与实际相符合，如果后进先出，会得到一个不同的信号序列。

比如 and 门输入从 0， 1 变为 1，0。尽管是同时发生，但仍有一个先后次序。如果先 0->1 再  1->0，则：

先入先出产生的输出信号为: 0(0), 1(3), 0(3)              ;;括号中的是时刻

如果是后进先出产生的输出信号为：0(0), 0(3)

[ 本帖最后由 win_hate 于 2008-12-29 23:34 编辑 ]

---

作者: win_hate    时间: 2009-01-01 11:49
标题: Exercise 3.33.
Exercise 3.33.  Using primitive multiplier, adder, and constant constraints, define a procedure averager that takes three connectors a, b, and c as inputs and establishes the constraint that the value of c is the average of the values of a and b.

---

作者: win_hate    时间: 2009-01-01 11:51
标题: Exercise 3.33. 答案 (上)

1. 
   
2. (define a (make-connector))
   
3. (define b (make-connector))
   
4. (define c (make-connector))
   
5. 
   
6. (define (average a b c)
   
7.   (let ((f (make-connector))
   
8.         (u (make-connector)))
   
9.     (adder a b u)
   
10.     (constant 2 f)
    
11.     (multiplier c f u)
    
12.     'ok))
    
13. 
    
14. (average a b c)
    
15. (probe 'c c)
    
16. (probe 'a a)
    
17. (probe 'b b)
    

复制代码

演示

1. 
   
2. > (set-value! a 10 'zxl)
   
3. 
   
4. Probe: a = 10done
   
5. > (set-value! b 20 'win_hate)
   
6. 
   
7. Probe: b = 20
   
8. Probe: c = 15done
   
9. > (forget-value! b 'zxl)
   
10. ignored
    
11. > (forget-value! b 'win_hate)
    
12. 
    
13. Probe: b = ?
    
14. Probe: c = ?done
    
15. > (set-value! c 20 'zxl)
    
16. 
    
17. Probe: c = 20
    
18. Probe: b = 30done
    

复制代码

[ 本帖最后由 win_hate 于 2009-1-1 11:54 编辑 ]

---

作者: win_hate    时间: 2009-01-01 12:11
标题: Exercise 3.33. 答案 (下)
对 Probe 时机的讨论。

如果我们把开始的代码改为：

1. 
   
2. (define a (make-connector))
   
3. (define b (make-connector))
   
4. (define c (make-connector))
   
5. 
   
6. (define (average a b c)
   
7.   (let ((f (make-connector))
   
8.         (u (make-connector)))
   
9.     (adder a b u)
   
10.     (constant 2 f)
    
11.     (multiplier c f u)
    
12.     'ok))
    
13. 
    
14. (probe 'b b)
    
15. (average a b c)
    
16. (probe 'c c)
    
17. (probe 'a a)
    

复制代码

不同之处仅在于 (probe 'b b) 一句提到 (average a b c) 前面了。运行结果变为

1. 
   
2. guile> (load "3.33.scm")
   
3. guile> (set-value! a 10 'zxl)
   
4. 
   
5. Probe: a = 10done
   
6. guile> (set-value! b 20 'win_hate)
   
7. 
   
8. Probe: c = 15
   
9. Probe: b = 20done
   
10. guile> (forget-value! b 'win_hate)
    
11. 
    
12. Probe: c = ?
    
13. Probe: b = ?done
    

复制代码

看上去是先 forget c ，然后才 forget b 的。但我们给出的指令是让 b forget，它 forget 后再通知周边约束，使 forget 指令传播出去。所以现在的输出有点可疑。

仔细分析一下代码，就会发现，连接器把约束存放在一个列表里，使用的方法是后进先出。Probe 也是一个约束器件：

• 设 Probe 是 b 的最后一个约束。b forget 掉自己的值后，以后进先出的方式遍历它的全体约束，并发送 forget 信息。第一个收到信息的约束器件为 b 的 Probe，于是立刻打印出 b 当前值，即 `?'。过一段时间后，连接器 c 收到 forget 信息，它也 forget 掉自己的值，然后它的 probe 打印出 c 的当前值为 `?'。
  
• 设 Probe 是 b 第一个约束。b forget 掉自己的值后，以后进先出的方式遍历它的全体约束，并发送 forget 信息。最后一个收到信息的约束器件为 b 的 Probe，在此之前，forget 信息已经被其它约束传播出去，个系统中应该 forget 的信息都已经 forget 掉了。所以 b 的 Probe 在最后一刻才打印出 '?'。但 b 的值的确是最早 forget 掉的，只是没有机会输出 Probe 信息而已。
  

[ 本帖最后由 win_hate 于 2009-1-2 11:08 编辑 ]

---

作者: win_hate    时间: 2009-01-02 11:02
标题: Exercise 3.34.
Exercise 3.34.  Louis Reasoner wants to build a squarer, a constraint device with two terminals such that the value of connector b on the second terminal will always be the square of the value a on the first terminal. He proposes the following simple device made from a multiplier:

(define (squarer a b)
  (multiplier a a b))

There is a serious flaw in this idea. Explain.

---

作者: win_hate    时间: 2009-01-02 11:08
标题: Exercise 3.34. 答案
乘法器的三个连接器中，有两个确定了，才能求出第三个。

这个 squarer 的实现中，本质上只有两个连接器。在 a 给定时，三个连接器中有两个有值，所以能求出 b。但 b 给定时，另外‘两’ 个连接器 a 没有值。按乘法器的设计，只有一个值是无法求出另外两个值的。

---

作者: win_hate    时间: 2009-01-03 10:26
标题: Exercise 3.35.
Exercise 3.35.  Ben Bitdiddle tells Louis that one way to avoid the trouble in exercise 3.34 is to define a squarer as a new primitive constraint. Fill in the missing portions in Ben's outline for a procedure to implement such a constraint:

(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))
            <alternative1>)
        <alternative2>))
  (define (process-forget-value) <body1>)
  (define (me request) <body2>)
  <rest of definition>
  me)

---

作者: win_hate    时间: 2009-01-03 10:30
标题: Exercise 3.35. 答案

1. 
   
2. (define (squarer a b)
   
3.   (define (process-new-value)
   
4.     (if (has-value? b)
   
5.         (if (< (get-value b) 0)
   
6.             (error "square less than 0 -- SQUARER" (get-value b))
   
7.             (set-value! a (sqrt (get-value b)) me))
   
8.         (if (has-value? a)
   
9.             (set-value! b (* (get-value a) (get-value a)) me))))
   
10.     (define (process-forget-value)
    
11.       (forget-value! a me)
    
12.       (forget-value! b me)
    
13.       (process-new-value))
    
14.     (define (me request)
    
15.       (cond ((eq? request 'I-have-a-value)
    
16.              (process-new-value))
    
17.             ((eq? request 'I-lost-my-value)
    
18.              (process-forget-value))
    
19.             (else
    
20.              (error "Unknown request -- SQUARER" request))))
    
21.     (connect a me)
    
22.     (connect b me)
    
23.     me)
    

复制代码

演示使用的代码

1. 
   
2. (load "3.35.scm")
   
3. 
   
4. (define a (make-connector))
   
5. (define b (make-connector))
   
6. 
   
7. 
   
8. (squarer a b)
   
9. (probe 'a a)
   
10. (probe 'b b)
    

复制代码

交互环境中的演示：

1. 
   
2. > (load "test.scm")
   
3. > (set-value! a 100 'zxl)
   
4. 
   
5. Probe: a = 100
   
6. Probe: b = 10000done
   
7. > (forget-value! a 'zxl)
   
8. 
   
9. Probe: a = ?
   
10. Probe: b = ?done
    
11. > (set-value! b 100 'zxl)
    
12. 
    
13. Probe: b = 100
    
14. Probe: a = 10.0done
    
15. > (forget-value! b 'zxl)
    
16. 
    
17. Probe: b = ?
    
18. Probe: a = ?done
    
19. > (set-value! a -10 'zxl)
    
20. 
    
21. Probe: a = -10
    
22. Probe: b = 100done
    

复制代码

---

作者: win_hate    时间: 2009-01-04 11:43
标题: Exercise 3.36.
Exercise 3.36.  Suppose we evaluate the following sequence of expressions in the global environment:

(define a (make-connector))
(define b (make-connector))
(set-value! a 10 'user)

At some time during evaluation of the set-value!, the following expression from the connector's local procedure is evaluated:

(for-each-except setter inform-about-value constraints)

Draw an environment diagram showing the environment in which the above expression is evaluated.

---

作者: win_hate    时间: 2009-01-04 11:43
标题: Exercise 3.36. 答案
<wait for pic>

---

作者: win_hate    时间: 2009-01-04 11:44
标题: Exercise 3.37.
Exercise 3.37.  The celsius-fahrenheit-converter procedure is cumbersome when compared with a more expression-oriented style of definition, such as

(define (celsius-fahrenheit-converter x)
  (c+ (c* (c/ (cv 9) (cv 5))
          x)
      (cv 32)))
(define C (make-connector))
(define F (celsius-fahrenheit-converter C))

Here c+, c*, etc. are the ``constraint'' versions of the arithmetic operations. For example, c+ takes two connectors as arguments and returns a connector that is related to these by an adder constraint:

(define (c+ x y)
  (let ((z (make-connector)))
    (adder x y z)
    z))

Define analogous procedures c-, c*, c/, and cv (constant value) that enable us to define compound constraints as in the converter example above.

---

作者: win_hate    时间: 2009-01-04 11:44
标题: Exercise 3.37. 答案

1. 
   
2. (define (c+ x y)
   
3.   (let ((z (make-connector)))
   
4.     (adder x y z)
   
5.     z))
   
6. 
   
7. (define (c* x y)
   
8.   (let ((z (make-connector)))
   
9.     (multiplier x y z)
   
10.     z))
    
11. 
    
12. (define (c/ x y)
    
13.   (let ((z (make-connector)))
    
14.     (multiplier z y x)
    
15.     z))
    
16. 
    
17. (define (cv c)
    
18.   (let ((x (make-connector)))
    
19.     (constant c x)
    
20.     x))
    
21. 
    
22. (define (celsius-fahrenheit-converter x)
    
23.   (c+ (c* (c/ (cv 9) (cv 5))
    
24.           x)
    
25.       (cv 32)))
    
26. 
    
27. (define C (make-connector))
    
28. (define F (celsius-fahrenheit-converter C))
    
29. (probe 'C C)
    
30. (probe 'F F)
    

复制代码

---

作者: win_hate    时间: 2009-01-05 11:47
本节完。

---

欢迎光临 Chinaunix (http://bbs.chinaunix.net/)

Powered by Discuz! X3.2