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

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

学习资料：

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.24(p187)

(define false #f)
(define true #t)

(define (make-table same-key?)
    (define (assoc key records)
        (cond ((null? records) false)
                ((same-key? key (caar records)) (car records))
                (else (assoc key (cdr records)))))
    (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 (same-key? key1 key2)
    (< (abs (- key1 key2)) 1e-3))

(define operation-table (make-table same-key?))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

; test
(put 1.0 2.0 3)
(display (get 1.0 1.9999))
(newline)

(exit)

结果如下：

3.25(p187)

利用递归即可，注意一些细节：

(define false #f)
(define true #t)

; table
(define (assoc key records)
    ; key: k
    ; records: ((k v))
    (cond ((null? records) false)
           ((not (pair? records)) false)
           ((equal? key (caar records)) (car records))
           (else (assoc key (cdr records)))))

(define (get-value records)
    ; (1.0 (2.0 . 3))
    (cdadr records))

(define (make-table)
    (list '*table*))

(define (lookup key-list table)
    (let ((record (assoc (car key-list) (cdr table))))
         (if record
             (cond ((null? key-list) false)
                   ((not table) false)
                   ((null? (cdr key-list))
                        (if (equal? (car key-list) (car record))
                            (cdr record)
                            false))
                   (else (lookup (cdr key-list) record)))
             false)))

(define (insert! key-list value table)    
    (let ((subtable (assoc (car key-list) (cdr table))))
        (if subtable
            ; 如果不是空表
            ; 单个元素则直接insert, 否则递归
            (cond ((null? (cdr key-list))
                        (set-cdr! subtable value)
                        table)
                  (else (insert! (cdr key-list) value subtable)
                        table))
            ; 空表
            ; 单个元素则直接insert, 否则递归
            (cond ((null? (cdr key-list))
                        (set-cdr! table
                            (cons (cons (car key-list) value)
                                (cdr table)))
                        table)
                  (else (set-cdr! table
                            ; 新表以(list (car key-list))开头
                            (cons (insert! (cdr key-list) value (list (car key-list)))
                                (cdr table)))
                        table)))))              

(define table (make-table))

(define k1 (list 1))
(define k2 (list 1 2))
(define k3 (list 1 2 3))

(insert! k1 1 table)
(display (lookup k1 table))
(newline)
(display (lookup k2 table))
(newline)
(display (lookup k3 table))
(newline)

(insert! k2 2 table)
(display (lookup k2 table))
(newline)
(display (lookup k3 table))
(newline)

(insert! k3 3 table)
(display (lookup k3 table))
(newline)

(insert! k1 4 table)
(display (lookup k1 table))
(newline)

(exit)

结果如下：

1
#f
#f
2
#f
3
4

3.26(p187)

(load "helper.scm")

; table: (*table*, tree)
; records: ((key, value), left, right)
(define (get-pair record)
    (car record))

(define (get-key record)
    (caar record))

(define (get-value recore)
    (cadr record))

(define (set-root key value tree)
    (set-car! tree (cons key value)))

(define (set-left node tree)
    (set-car! (cdr tree) node))

(define (set-right node tree)
    (set-car! (cddr tree) node))

(define (tree-insert key value tree)
    (cond 
        ((null? tree)
            (make-tree (cons key value) '() '()))
        ((= key (get-key tree))
            (set-root key value tree)
            tree)
        ((< key (get-key tree)) 
            (set-left (tree-insert key value (left-branch tree)) tree)
            tree)
        (else 
            (set-right (tree-insert key value (right-branch tree)) tree)
            tree)))

(define (lookup key table)
  (let ((record (assoc key (right-branch table))))
    (if record
        (cdr record)
        false)))

; return (key, value)
(define (assoc key records)
    (cond ((null? records) false)
            ((= key (get-key records)) (get-pair records))
            ((< key (get-key records)) (assoc key (left-branch records)))
            (else (assoc key (right-branch records)))))

(define (insert! key value table)
    ; table: ('*table* '() '())
    (let ((tree (right-branch table)))
        (set-car! (cddr table) (tree-insert key value tree))))

(define (make-table)
    (make-tree '*table* '() '()))

(define k1 10)
(define v1 10)
(define k2 9)
(define v2 9)
(define k3 8)
(define v3 8)

; test
(define table (make-table))
(insert! k1 v1 table)
(display (lookup k1 table))
(newline)

(insert! k2 v2 table)
(display (lookup k2 table))
(newline)

(insert! k3 v3 table)
(display (lookup k3 table))
(newline)

(insert! k1 v2 table)
(display (lookup k1 table))
(newline)

(insert! k2 v3 table)
(display (lookup k2 table))
(newline)

(insert! k3 v1 table)
(display (lookup k3 table))
(newline)

(exit)

结果如下：

3.27(p188)

如果$f(k)$已经计算过，则在$\Theta(1)$的时间内查询结果；否则计算$f(k)$并存入表中，因此时间复杂度为$\Theta(n)$。

如果定义将memo-fib定义为(memoize fib)，则无法产生该效果，以为table不是共用的。

3.28(p192)

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

3.29(p192)

注意到有如下关系

$a\or b = \neg((\neg a) \and (\neg b))$

所以

$\text{or-gate-delay}= 2\times \text{inverter-delay} + \text{and-gate-delay}$

代码如下

(load "helper.scm")

(define (or-gate a1 a2 output)
    (inverter a1 a3)
    (inverter a2 a4)
    (and-gate a3 a4 a5)
    (inverter a5 output)
    'ok)

3.30(p192)

(define (ripple-carry-adder A B S C)
    (define (adder-iter A B S C-in C)
        (if (not (null? A))
            ((full-adder (car A) (car B) C-in (car S) C)
             (set! C-in (get-signal C))
             (add-iter (cdr A) (cdr B) C-in (cdr S) C))))
    (define C-in (make-wire))
    (set-signal! C-in 0)
    (add-iter A B S C-in C))

3.31(p195)

参考资料：

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

proc作用是产生初始化动作，代码如下：

(load "helper.scm")
(load "digital_circuits.scm")

(define (make-wire)
  (let ((signal-value 0) (action-procedures '()))
    (define (set-my-signal! new-value)
      (if (not (= signal-value new-value))
          (begin (set! signal-value new-value)
                 (call-each action-procedures))
          'done))
    (define (accept-action-procedure! proc)
      (set! action-procedures (cons proc action-procedures)))
      ;(proc))
    (define (dispatch m)
      (cond ((eq? m 'get-signal) signal-value)
            ((eq? m 'set-signal!) set-my-signal!)
            ((eq? m 'add-action!) accept-action-procedure!)
            (else (error "Unknown operation -- WIRE" m))))
    dispatch))

; test
(define the-agenda (make-agenda))
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay 5)
(define input (make-wire))
(define output (make-wire))

(probe 'inverter output)
(inverter input output)
(set-signal! input 1)
(propagate)

(exit)

实验的结果是没有输出。

3.32(p197)

genda的形式：

$t_0 : (a_{01},a_{02},\ldots)$
$t_1: (a_{11},a_{12},\ldots)$

参考资料：

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

使用先进先出的原因是这样符合事物完成的顺序。

考虑与门：

a1 a2 out
1  1  1

假设如下三个操作在同一队列中：

0: queue (nota1, nota2, and)

先进先出：

a1 a2 out
1  1  #
0  1  #
0  0  0

后进先出：

可以看到out的结果不同。