SICP 习题参考答案 3.3

win_hate

由于 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

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

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

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

前面的队列使用了一个单链表：


改成双向的。

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

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

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

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

思路

• 多重键值的处理
  
  一个直接的思路是递归处理键值。例如，'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

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.)