计算机程序的构造和解释(SICP) 第3章 习题解析 Part2

这次回顾第三章第二部分习题。

学习资料：

https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/index.htm

https://github.com/DeathKing/Learning-SICP

https://mitpress.mit.edu/sites/default/files/sicp/index.html

https://www.bilibili.com/video/BV1Xx41117tr?from=search&seid=14983483066585274454

参考资料：

https://sicp.readthedocs.io/en/latest

http://community.schemewiki.org/?SICP-Solutions

http://community.schemewiki.org/?sicp

3.12(p175)

z
(cdr x)

(b)

w
(cdr x)

(b c d)

3.13(p176)

盒子指针图见如下链接：

https://sicp.readthedocs.io/en/latest/chp3/13.html

会进入死循环，因为是一个圈。

3.14(p176)

函数运行的过程如下：

x 			 y

x 			 ()
(cdr x) 	 ((car x))
(cddr x) 	 ((cdar x) (car x))
(cdddr x) 	 ((cddar x) (cdar x) (car x))
...
() 			(... (cddar x) (cdar x) (car x))

所以函数的作用是

(reverse x)

运行验证：

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

(define v (list 'a 'b 'c 'd))
(define w (mystery v))
(display w)
(exit)

实验结果如下：

(a b c d) ()
(b c d) (a)
(c d) (b a)
(d) (c b a)
() (d c b a)
(d c b a)

3.15(p178)

盒子指针图见如下链接：

https://sicp.readthedocs.io/en/latest/chp3/15.html

3.16(p178)

参考资料：

https://sicp.readthedocs.io/en/latest/chp3/16.html

http://community.schemewiki.org/?sicp-ex-3.16

题目中所说的三个序对含义是指构造中使用了三次cons，代码如下：

(load "helper.scm")

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

(define (show-result arr name)
    (display name)
    (display ": ")
    (display arr)
    (newline)
    (display "count-pairs: ")
    (display (count-pairs arr))
    (newline))

; test
(define x (cons 1 '()))
(define y (cons x x))

(define l1 (cons 1 (cons 2 (cons 3 '()))))
(show-result l1 "l1")
(define l2 (cons x (cons 2 x)))
(show-result l2 "l2")
(define l3 (cons y y))
(show-result l3 "l3")
(define l4 (cons 1 (cons 2 (cons 3 '()))))
(set-cdr! (last-pair l4) l4)
;(display (count-pairs l4))

(exit)

实验结果如下：

l1: (1 2 3)
count-pairs: 3
l2: ((1 . 2) 2 1 . 2)
count-pairs: 4
l3: (((1 . 2) 1 . 2) (1 . 2) 1 . 2)
count-pairs: 7

3.17(p178)

参考资料：

https://sicp.readthedocs.io/en/latest/chp3/17.html

(define (count-pairs x)
    (define (contain? element h-set)
        (cond ((null? h-set) #f)
            ;   ((not (pair? h-set)) #t)
              ((eq? (car h-set) element) #t)
              (else (contain? element (cdr h-set)))))

    (define (count-pairs-iter x hash-set)
        (if (and (pair? x)
                 (not (contain? x hash-set)))
            (count-pairs-iter (car x)
                (count-pairs-iter (cdr x) (cons x hash-set)))
        hash-set))
    
    (length (count-pairs-iter x '())))

(define (show-result arr)
    (display "count-pairs: ")
    (newline)
    (display (count-pairs arr))
    (newline))

; test
(define x (cons 1 '()))
(define y (cons x x))

(define l1 (cons 1 (cons 2 (cons 3 '()))))
(show-result l1)
(define l2 (cons x (cons 2 x)))
(show-result l2)
(define l3 (cons y y))
(show-result l3)
(define l4 (cons 1 (cons 2 (cons 3 '()))))
(set-cdr! (last-pair l4) l4)
(show-result l4)

(exit)

结果如下：

count-pairs:
3
count-pairs:
3
count-pairs:
3
count-pairs:
3

3.18,3.19(p179)

利用快慢指针即可：

(define (contain-cycle? x)
    (define (check ptr1 ptr2)
        (cond ((null?  ptr1) #f)
              ((null?  ptr2) #f)
              ((null? (cdr ptr2)) #f)
              ((eq? ptr1 ptr2) #t)
              (else (check (cdr ptr1) (cddr ptr2)))))
    (if (null? x)
        #t
        (check x (cdr x))))

; test
(define x (cons 1 '()))
(define y (cons x x))

(define l1 (cons 1 (cons 2 (cons 3 '()))))
(display (contain-cycle? l1))
(newline)
(define l2 (cons x (cons 2 x)))
(display (contain-cycle? l2))
(newline)
(define l3 (cons y y))
(display (contain-cycle? l3))
(newline)
(define l4 (cons 1 (cons 2 (cons 3 '()))))
(set-cdr! (last-pair l4) l4)
(display (contain-cycle? l4))
(newline)

(exit)

结果如下：

#f
#f
#f
#t

3.20(p179)

参考如下链接：

https://sicp.readthedocs.io/en/latest/chp3/20.html

3.21(p183)

delete-queue!返回queue对象，而真正的队列实际上是front-ptr。

(load "helper.scm")

(define (print-queue queue)
    (display (front-ptr queue))
    (newline))

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

(exit)

结果如下：

(a)
(a b)
(b)
()

3.22(p183)

(define (make-queue)
    (let ((front-ptr '())
          (rear-ptr  '()))
        (define (set-front-ptr! item) 
            (set! front-ptr item))
         (define (set-rear-ptr! item)
            (set! rear-ptr item))

        (define (empty-queue?)
            (null? front-ptr))
        (define (front-queue)
            (if (empty-queue?)
                (error "FRONT called with an empty queue" (cons front-ptr rear-ptr))
                (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)
                        (cons front-ptr rear-ptr))
                      (else
                        (set-cdr! rear-ptr new-pair)
                        (set-rear-ptr! new-pair)
                        (cons front-ptr rear-ptr))))) 
        (define (delete-queue!)
            (cond ((empty-queue?)
                    (error "DELETE! called with an empty queue" (cons front-ptr rear-ptr)))
                (else
                    (set-front-ptr! (cdr front-ptr))
                    (cons 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!)
                  (else (error "Undefined operation -- QUEUE" m))))
        dispatch))

(define (empty-queue? queue)
    ((queue 'empty-queue?)))

(define (front-queue queue)
    ((queue 'front-queue)))

(define (insert-queue! queue item)
    ((queue 'insert-queue!) item))

(define (delete-queue! queue)
    ((queue 'delete-queue!)))

; test
(define q (make-queue))
(display (insert-queue! q 'a))
(newline)
(display (insert-queue! q 'b))
(newline)
(display (front-queue q))
(newline)
(display (delete-queue! q))
(newline)
(display (delete-queue! q))
(newline)
(display (empty-queue? q))
(newline)

(exit)

结果如下：

((a) a)
((a b) b)
a
((b) b)
(() b)
#t

3.23(p183)

参考资料：

http://cn.voidcc.com/question/p-tbsxmrdg-qr.html

http://cn.voidcc.com/question/p-tbsxmrdg-qr.html

http://www.voidcn.com/article/p-xqhnuwga-but.html

http://community.schemewiki.org/?sicp-ex-3.23

deque需要使用双向链表实现：

; 双向链表
; v, next, prev
(define (node v)
    (cons (cons v '()) '()))

(define (value v)
    (caar v))

(define (next node)
    (cdar node))

(define (prev node)
    (cdr node))

(define (set-next n1 n2)
    (set-cdr! (car n1) n2))

(define (set-prev n1 n2)
    (set-cdr! n1 n2))

; test
(define n1 (node 1))
(define n2 (node 2))
(define n3 (node 3))
(set-next n1 n2)
(set-prev n1 n3)
(display (prev n1))
(newline)
(display (next n1))
(newline)
(display (value n1))
(newline)
(display (value n2))
(newline)
(display (value n3))

(exit)

结果如下：

((3))
((2))
1
2
3

还有需要注意的一点是由于涉及到循环，所以不能直接使用display打印结果，需要自己定义display函数，整体代码如下：

(load "Link-List.scm")

(define (make-deque)
    ; l为deque长度, 打印的时候使用
    (let ((front-ptr '())
          (rear-ptr  '())
          (l 0))
        (define (set-front-ptr! item) 
            (set! front-ptr item))
         (define (set-rear-ptr! item)
            (set! rear-ptr item))
        
        (define (empty-deque?)
            (null? front-ptr))

        (define (front-deque)
            (if (empty-deque?)
                (error "FRONT called with an empty deque" (cons front-ptr rear-ptr))
                (car front-ptr)))

        (define (rear-deque)
            (if (empty-deque?)
                (error "REAR called with an empty deque" (cons front-ptr rear-ptr))
                (car rear-ptr)))

        (define (front-insert-deque! item)
            (set! l (+ l 1))
            (let ((new-pair (node item)))
                (cond ((empty-deque?)
                        (set-front-ptr! new-pair)
                        (set-rear-ptr! new-pair)
                        (cons front-ptr rear-ptr))
                    (else
                        ; prev和next都需要设置
                        (set-next new-pair front-ptr)
                        (set-prev front-ptr new-pair)
                        (set-front-ptr! new-pair)
                        (cons front-ptr rear-ptr)))))

        (define (rear-insert-deque! item)
            (set! l (+ l 1))
            (let ((new-pair (node item)))
                (cond ((empty-deque?)
                        (set-front-ptr! new-pair)
                        (set-rear-ptr! new-pair)
                        (cons front-ptr rear-ptr))
                    (else
                        ; prev和next都需要设置
                        (set-prev new-pair rear-ptr)
                        (set-next rear-ptr new-pair)
                        (set-rear-ptr! new-pair)
                        (cons front-ptr rear-ptr))))) 

        (define (front-delete-deque!)
            (cond ((empty-deque?)
                    (error "DELETE! called with an empty deque" (cons front-ptr rear-ptr)))
                (else
                    (set! l (- l 1))
                    (set-front-ptr! (next front-ptr))
                    (cons front-ptr rear-ptr)))) 

        (define (rear-delete-deque!)
            (cond ((empty-deque?)
                    (error "DELETE! called with an empty deque" (cons front-ptr rear-ptr)))
                (else
                    (set! l (- l 1))
                    (set-rear-ptr! (prev rear-ptr))
                    (cons front-ptr rear-ptr))))
        
        ; 处理有环的打印
        (define (display-deque)
            (define (display-iter x arr cnt)
                (if (= cnt 0)
                    arr
                    (display-iter (next x) (cons (value x) arr) (- cnt 1))))
            (display (list (reverse (display-iter front-ptr '() l)) (value rear-ptr))))

        (define (dispatch m)
            (cond ((eq? m 'empty-deque?) empty-deque?)
                  ((eq? m 'front-deque) front-deque)
                  ((eq? m 'rear-deque) rear-deque)
                  ((eq? m 'front-insert-deque!) front-insert-deque!)
                  ((eq? m 'rear-insert-deque!) rear-insert-deque!)
                  ((eq? m 'front-delete-deque!) front-delete-deque!)
                  ((eq? m 'rear-delete-deque!) rear-delete-deque!)
                  ((eq? m 'display-deque) display-deque)
                  (else (error "Undefined operation -- DEQUE" m))))
        dispatch))

(define (empty-deque? deque)
    ((deque 'empty-deque?)))

(define (front-deque deque)
    ((deque 'front-deque)))

(define (rear-deque deque)
    ((deque 'rear-deque)))

(define (front-insert-deque! deque item)
    ((deque 'front-insert-deque!) item))

(define (rear-insert-deque! deque item)
    ((deque 'rear-insert-deque!) item))

(define (front-delete-deque! deque)
    ((deque 'front-delete-deque!)))

(define (rear-delete-deque! deque)
    ((deque 'rear-delete-deque!)))

(define (display-deque deque)
    ((deque 'display-deque)))

(define q (make-deque))

(display "(front-insert-deque! q 'a)")
(newline)
(front-insert-deque! q 'a)
(display-deque q)
(newline)

(display "(front-insert-deque! q 'b)")
(newline)
(front-insert-deque! q 'b)
(display-deque q)
(newline)

(display "(rear-insert-deque! q 'c)")
(newline)
(rear-insert-deque! q 'c)
(display-deque q)
(newline)

(display "(rear-insert-deque! q 'd)")
(newline)
(rear-insert-deque! q 'd)
(display-deque q)
(newline)

(display "(front-delete-deque! q)")
(newline)
(front-delete-deque! q)
(display-deque q)
(newline)

(display "(front-delete-deque! q)")
(newline)
(front-delete-deque! q)
(display-deque q)
(newline)

(display "(rear-delete-deque! q)")
(newline)
(rear-delete-deque! q)
(display-deque q)
(newline)

(exit)

结果如下：

(front-insert-deque! q 'a)
((a) a)
(front-insert-deque! q 'b)
((b a) a)
(rear-insert-deque! q 'c)
((b a c) c)
(rear-insert-deque! q 'd)
((b a c d) d)
(front-delete-deque! q)
((a c d) d)
(front-delete-deque! q)
((c d) d)
(rear-delete-deque! q)
((c) c)