SICP-CH3 模块化,对象和状态

3.1赋值和局部状态
3.2求值环境模型
用变动数据做模拟

[碎碎念] 上一章还有几个实例的习题没有完成, 然而时间太有限了, 所以决定先挖新一章的坑把这本书大略学习完, 之后再来填那些实例, /跪

前两章介绍了如何把 基本过程 和 基本数据 组合起来. 但有效的程序综合还需要一些 组织原则.
本章将研究两种特点鲜明的组织策略:

对象途径: 需要关注计算对象可以怎样变化同时保持其标识.
流方式 : 可以松懈我们对时间的模拟与计算机求值过程中的各种事件的发生顺序.

3.1赋值和局部状态

所谓一个对象 有状态 ,就是说它的行为受到它的历史的影响.
所谓 交互, 就是建立起一个对象的状态变量与其它对象的状态变量之间的联系.
所谓 独立对象,就是把一个系统中的状态变量'分组',形成一些内部聚合的子系统,每个子系统与其它子系统之间只存在松散的联系.
每个对象需要有一些 局部状态变量,用于描述实际的对象状态.
语言中需要提供 赋值运算符, 使我们能够通过人类可读的符号去模拟状态变量.

3.1.1局部状态变量

以银行账户为例,本节给出了三种维护状态的解决方案.

使用全局变量

(define balance 100)

使用let创建局部变量

(let ((balance 100))
   (lambda (amount)
       (if (>- balance amount)
           (begin (set! balance (- balance amount))
                  balance)
           "Insufficient funds")))

但是这种使用ser!与局部变量结合的技术在使用 代换模型 时会有问题, 后面会讲.
[一旦在语言里引进了赋值,代换就不再适合作为过程应用的模型了]

利用闭包

(define (make-withdraw balance)
    (lambda (amount)
      (if (>= balance amount)
          (begin (set! balance (- balance amount))
                 balance)
          "Insufficient funds")))

这样不必再使用let设置局部变量,因为形式参数本身就是局部的.下一节将讨论 求值的环境模型

习题3.1

写出一个生成累加器的过程make-accumulator.它所生成的每个累加器都维持一个独立的和.

(define (make-accumulator ini-val)
  (lambda (amount)
    (begin
      (set! ini-val (+ amount ini-val))
      ini-val)))

(define A (make-accumulator 1))
(A 1) ; val->2
(A 2) ; val->4

习题3.2

实现一个可以统计调用次数的过程.

(define (make-monitored proc)
  (define count 0)
  (define (how-many) count)
  (define (reset)
    (begin
      (set! count 0)
      count))
  (define (dispatch m)
    (cond ((eq? m 'how-many-calls?) (how-many))
          ((eq? m 'reset-count) (reset))
          (else
           (begin
             (set! count (+ 1 count))
             (proc m)))))
  dispatch)

;; Test
(define b (make-monitored sqrt))
(b 100)
(b 100)
(b 'how-many-calls?) ; val->2
(b 'reset-count)     ; val->1

习题3.3

为make-account添加密码. 没啥难度,添加一个参数和一个if就可以了.

(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch pw m)
    (if (eq? pw password) 
        (cond ((eq? m 'withdraw) withdraw)
              ((eq? m 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT" m)))
        (error "Invalid password" pw)))
  dispatch)
;; TEST
(define acc (make-account 100 'pw))
((acc 'foo 'withdraw ) 50) ;Invalid password p
((acc 'pw 'withdraw ) 50)  ; 50

习题3.4

继续修改make-account..如果被错误的连续调用了7次,它将call-the-cops

(define (make-account balance password)
  (define error-pw-cnt 0)
  (define (call-the-cops)
       (display "Calling cops......."))
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch pw m)
    (if (eq? pw password) 
        (cond ((eq? m 'withdraw) withdraw)
              ((eq? m 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT" m)))
        (begin
          (set! error-pw-cnt (+ 1 error-pw-cnt))
          (if (>  error-pw-cnt 7)
              (call-the-cops)
              (error "Invalid password" pw)))))
  dispatch)

3.1.2引进赋值带来的利益

将赋值引进所用的程序设计语言,将会使我们陷入许多困难的概念问题丛林之中. 将系统看做一集带有局部状态的对象,也是一种维护模块化设计的强有力的技术.
通过引进 赋值 和 将状态隐藏在局部变量中 的技术, 我们能以一种更模块化的方式构造系统.

(define rand
  (let ((x 1))
    (lambda ()
      (set! x (rand-update x))
      x)))

例子: \(6/pi^2\) 是两个随机选取整数没有公共因子的概率,现在考虑用随机数来实现一种 蒙特卡洛模拟 的技术. (真是长姿势了…

(define (estimate-pi trials)
  (sqrt (/ 6 (monte-carlo trials cesaro-test))))
(define (cesaro-test)
  (= (gcd (random 10000) (random 10000)) 1))
(define (monte-carlo trials experiment)
  (define (iter trials-remaining trials-passed)
    (cond ((= trials-remaining 0)
           (/ trials-passed trials))
          ((experiment)
           (iter (- trials-remaining 1) (+ trials-passed 1)))
          (else
           (iter (- trials-remaining 1) trials-passed))))
  (iter trials 0))
; 测试
(estimate-pi 2000)

习题3.5

利用蒙特卡罗计算矩形中一个圆的面积,然后通过面积估算pi值. 这道题思路跟上面差不多,只是处理坐标稍稍麻烦一点.

(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (random range))))

(define (estimate-pi trials x1 y1 x2 y2)
  (define radio (min (/ (abs (- x2 x1)) 2) (/ (abs (- y2 y1)) 2)))
  (define area (* (monte-carlo trials radio x1 y1 x2 y2)
                  (* (abs (- x2 x1)) (abs (- y2 y1)))))
  (/ area (expt radio 2)))

(define (radio-test radio x1 y1 x2 y2)
  (define x (- (random-in-range x1 x2) (/ (- x2 x1) 2)))
  (define y (- (random-in-range y1 y2) (/ (- y2 y1) 2)))
  (< (+ (expt x 2) (expt y 2)) (expt radio 2)))

(define (monte-carlo trials radio x1 y1 x2 y2)
  (define (iter trials-remaining trials-passed)
    (cond ((= trials-remaining 0)
           (/ trials-passed trials))
          ((radio-test radio x1 y1 x2 y2)
           (iter (- trials-remaining 1) (+ trials-passed 1)))
          (else
           (iter (- trials-remaining 1) trials-passed))))
  (iter trials 0))

习题3.6

实现一个可以重置随机数种子的random. \ 因为MIT-scheme中没有提供随机数种子生成器,所以这里只简单打印种子数值,毕竟玩弄闭包才是重点嘛2333

(define (inner-rand seed)
  (lambda (cmd)
    (cond ((eq? cmd 'generate)
           (set! seed (+ 1 seed))
           seed)
          ((eq? cmd 'reset)
           (lambda (new-value)
             (set! seed new-value)
             seed)))))

(define rand (inner-rand 1))

(rand 'generate)
((rand 'reset) 1)

3.1.3引进赋值的代价

只要我们不使用赋值, 以同样参数对一个函数求值一定会产出同样的结果(传说中的可重入嘛?).
不使用赋值的设计称为 函数式程序设计

引入赋值的代价之一是 无法使用代换模型 , 因为我们无法区分出现在set! 前后的两个同样的变量, 它们不应该被同时代换掉.

同一和替换

一旦将变化引入计算模型, 其影响比打破一个代换模型要深远的多.首先考虑两个物体"同一"的概念.
以习题3.6的rand为例:\n

(define rand (inner-rand 1)) 
(define rand1 (inner-rand 1)) 
(define rand2 (inner-rand 2))

rand和rand1是同一的吗? 是, 因为他们有同样的计算行为.
rand1和rand2是同一的吗? 不是, 因为他们计算行为不同.
虽然rand1和rand2是通过同样的方式创造出来的, 从这个角度可以说他们 同一.
但如果要求rand1和rand2在任何时候求值结果相同, 就无法说它们同一了.

如果一个语言支 同一的东西可以相互替换 的观念,这样替换不会改变有关表达式的值, 那么这个语言就具有 引用透明性. 我们的计算力包含 set! 之后,就 打破 了引用透明性.

引入赋值后, 判断两样东西是否 同一 就变成了一件 错综复杂 的事. 两个指向同一实例的指针"同一"否? 两个相同类的不同实例"同一"否?

命令式程序设计的缺陷

与函数式程序设计相对应的是,广泛采用 赋值 的程序设计被称为命令式程序设计.

一般而言,带有赋值的程序将强迫人们考虑赋值的顺序.而在函数式编程中这种情况不会出现.
如果考虑到并发, 命令式程序设计的复杂性还会变得更糟.

习题3.7

这道题目看了半天才明白一点..其实很简单,在ex3.3的account外再套一层即可.

(define (make-joint account pw new-pw)
  (lambda (password mode)
    (if (eq? password new-pw)
        (account pw mode)
        (error "Invalid password" password))))
;; test
(define acc (make-account 100 'pw))
(define acc-joint (make-joint acc 'pw 'new))
((acc-joint 'new 'withdraw) 50) ; 50

习题3.8

定义一个过程f, (+ (f 0) (f 1)) 从左到右求值返回0, 从右到左返回1.
解题思路:

f中应该带有状态,才会导致求值结果依赖求值顺序.
按照题目描述的数学性质,f中应该有一个乘法运算.

(define (inner count)
  (lambda (x) (set! count (* count x)) count))
(define f (inner 1))
(+ (f 0) (f 1)) ; val: 1
(+ (f 1) (f 0)) ; val: 0

可见我用的Mit-Scheme的求值顺序是从右到左.

3.2求值环境模型

前面有提到过,引进赋值后,求值的代换模型已经不再适用了.由于赋值的存在,变量已经不仅是某个值的名字. 此时必须以某种方式制定一个 位置, 相应的值可以储存在哪里. 在我们新的求值模型中, 我们将这个位置维持在称为 环境 的结构中.

约束 将一些变量关联于对应的值 框架 包含着一些约束的表格 环境 框架的序列

在一个程序语言里,一个表达式本身根本没有任何意义, 其解释要依赖于上下文.

求值规则

现在我们要用 求值的环境模型 代替 求值的代换模型.
在求值的环境模型里,一个过程总是一个对偶,由一些代码和一个指向环境的指针组成.
环境模型的规则

相对于一个给定环境 求lambda表达式 ,将创建一个 过程对象.
将一个 过程对象 应用于一集实际参数,将构造出一个新框架. 这是过程对象中的指针将指向新框架.

一些关键字:
define 的行为: 在当前环境框架里建立一个约束,并赋予这个符号指定的值.
set! 的行为: 在环境中找到包含这个变量约束的第一个框架, 然后 修改 这一框架.
过程对象 过程对象是一个序对,由lambda的正文和一个指向环境的指针组成.这个指针指向创建过程对象的环境.

简单的过程应用

练习3.9

分析对阶乘函数的递归版本和迭代版本分别应用环境求值模型时所创建的环境结构. 递归版本:

(define (factorial n)
  (if (= n 1)
      1
      (* (factorial (- n 1) n))))

对(factorial 6)求值的过程:

创建环境E1, 其中形参n绑定到实参6, factorial绑定到一个全局环境中的过程对象.
把过程factorial应用到实参6, 创建环境E2
把过程factorial应用到实参5, 创建环境E3
把过程factorial应用到实参4, 创建环境E4
把过程factorial应用到实参3, 创建环境E5
把过程factorial应用到实参2, 创建环境E6
把过程factorial应用到实参1, 创建环境E7
在E7中得到返回值1

迭代版本:

(define (factorial n)
  (fact-iter 1 1 n))
(define (fact-iter product counter max-count)
  (if (> counter max-count)
      product
      (fact-iter (* counter product)
                 (+ counter 1)
                 max-count)))

对(factorial 6)求值的过程:

创建E1, n绑定到实参6
把过程factorial应用到实参6, 创建E2. fact-iter绑定到过程对象, n绑定到6.
把过程fact-iter应用到实参1,1,6, 创建E3
把过程fact-iter应用到实参1,2,6, 创建E4
把过程fact-iter应用到实参2,3,6, 创建E5
把过程fact-iter应用到实参6,4,6, 创建E6
把过程fact-iter应用到实参24,5,6, 创建E7
把过程fact-iter应用到实参120,6,6, 创建E8
在E8中得到返回值720

将框架看做局部状态的展台

练习3.10

先把let替换成lambda表达式的形式:

(define (make-withdraw initial-amount)
  ((lambda (balance) (lambda (amount) ... )) initial-amount))

执行define

(define W1 (make-withdraw 100))

求值过程make-withdraw将设置环境E1,并将形参initial-amount约束到实参100.
在E1中求值make-withdraw

((lambda (balance) (lambda (amount) ... )) 100)

这个过程对象就作为调用make-withdraw的返回值,它的环境是E2,在全局环境中约束于W1.
此时,环境大概是这样的(我用E0来表示全局环境):

E0: make-withdraw,W1
E1: initial-amount = 100
E2: balance = 100
参数: amount
过程体: (lambda (amount) .... )

当我们把W1应用到一个参数时:

(W1 50)

将产生一个新框架E3,把形参amount绑定到实参50,过程体中的set!操作将会修改位于E2中的约束balance.
可见习题这个版本make-withdraw和3.2.3版本的make-withdraw创建出的对象具有相同对象, 不同的是习题版本额外创建了一个环境E1.

内部定义

内部过程定义的两个关键性质:

局部过程的名字不会与包容他们的过程之外的名字互相干扰. 应为局部过程名字是在该过程运行时创建的框架里面约束的.
局部过程只需要将包含着它们的过程的形参作为自由变量.

练习3.11

考虑3.11节的银行账户过程,展示由下列交互序列生成的环境结构.

(define acc (make-account 50))

在全局环境中约束acc到一个过程对象

E0: make-account =
      param: balance
      body: (define (withdraw amount)...
            (define (deposit ...
            (define (dispatch ...
      pointer:E0

    acc =
      param: m
      body: (cond ((eq ? m 'widthdraw...
                  ((eq ? m 'deposit...
      pointer:E1
      ---------------------------------
      E1: balance = 50
          withdraw ...
          deposit ...
          dispatch ...
      ---------------------------------

应用'deposit到acc

((acc 'deposit) 40)

创建新环境E2,E2是E1的下属, 把形参m绑定到实参'deposit,并返回一个过程对象.其中balance是被关联在E1中的实参.

E2: m = 'deposit
    局部过程 =
      param: amount
      body: (set! balance (+ balance amuont)
           balance
      pointer: E2

然后把实参40应用于返回的过程对象,创建新环境E3.E3是E2的下属,形参amount绑定实参40.

E3: amount = 40

对局部过程对象求值并返回,这将改变E1中的balance的值.
应用'withdraw到acc的过程和上面差不多,这里就略过了…

((acc 'withdraw) 60)
30

可以看到, acc的局部状态保存在E1中, 如果另外定义一个acc2, 则acc2的局部变量会保存在一个新框架中, 所以它们互相之间不会有影响.

用变动数据做模拟

作为对第二章数据抽象系统的扩展,为了模拟具有不断 变化 的状态的复合对象, 我们将设计出称为 改变函数 的操作.
比如表示银行账户的数据结构可能就需要接受下面的操作:

(set-balance! <accoun> <new-value>)

变动的表结构

针对序对的基本改变函数是 set-car! 和 set-cdr!.

(define x (cons 1 2))
x ; val->(1,2)
(set-car! x 3)
(set-cdr! x 4)
x ; val->(3,4)

习题3.12

append! 的功能与append类似, 不同的是它通过改变最后一个序对的cdr来达到追加表的目的.

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

碎碎念:直到看到这里我才意识到一个问题…(list x y z)构造出表(x y z),其中每个元素都是一个序对.以前一直没有理解这一点.
<response 1>: (b)

x: [a]-[b][]

<response 2>: (b c d)

x: [a]-[b]-[c]-[d][]

习题3.13

考虑下面make-cycle过程

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

画出盒子指针图形,说明下面表达式的结构

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

我尝试跑了一下,结果no zuo no die….
指针图形:

[a]-[b]-[c]--|
 |___________|

习题3.14

分析下面这个过程:

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

看上去是用来给序列逆序的,运行了一下果不其然.

(define v '(a b c d))
; v的盒子图形:
[a]-[b]-[c]-[d]

求值(define w (mystery v))之后,w和v的盒子图形是

w: [d]-[c]-[b]-[a]
v: [a]

这是由于v在第一次调用loop时被当做实参绑定到形参x,然后被set-cdr!改变.

共享和相等

在3.1.3节我们讨论过同一和变化的问题,当不同数据对象共享某些序对时,这些问题就到现实中来了. 考虑下面结构:

(define x '(a b))
(define z1 (cons x x))
(define z2 (cons '(a b) '(a b)))

其中,z1的car和cdr都指向同一个序对, 而z2的car和cdr不同,但它们使用的符号a,b是共享的.
但作为表来考虑,z1和z2都表示((a b) a b),如果我们只用cons,car,cdr对表进行操作,则其中的共享就不会被察觉. 但如果允许 改变 表结构的话, 共享的情况就会被暴露了.
检查表是否共享的一种方式是 eq?, 它检查x和y是否为同一个对象. (eq? (car z1) (cdr z1))为真,而 (eq? (car z2) (cdr z2))为假.

习题3.15

画出盒子指针图形,解释set-to-wow!对上面结构z1和z2的影响.

(define (set-to-wow! x)
  (set-car! (car x) 'wow)
  x)
(set-to-wow! z1);;Value 10: ((wow b) wow b)
(set-to-wow! z2);;Value 11: ((wow b) a b)

z1的盒子:

z1---[ ]  [ ]
      |    |
x ---[wow][ ]---[b][]

z2的盒子

z2---[ ][ ]---[ ][ ]---[ ][]
      |        |        |
      |       [wow]    [b]
      |       [a]       |
      |        |        |
      ------- [ ][ ]---[ ][]

习题3.16

考虑下面这个统计表结构中序对的过程

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

构造返回3,4,7的表

(define x3 (cons 'a '(c d)))
(define x4 (cons '(a b) (cons 'c 'd)))
(define x7 (cons '(a b) (list 'c '(d e))))

至于根本不返回的表..利用3.13的make-cycle就可以让count-pairs陷入无尽的循环中了√

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

习题3.17

设计一个count-pairs的正确版本.题目中给了提示,使用一个容器维护计算过的序对的轨迹.

(define (count-pairs-right x)
  (define (count-pairs-inner x viewed-pair)
    (define (is-pair-viewed? x)
      (define (iter arr x)
        (cond
         ((eq? arr '())  #F)
         ((eq? (car arr) x) #T)
         (else (iter (cdr arr) x))))
      (iter viewed-pair x))
    (define (count-iter x)
      (cond ((not (pair? x)) 0)
            ((is-pair-viewed? x)
             (+ (count-iter (car x))
                (count-iter (cdr x))))
            (else
             (append! viewed-pair (list x))
             (newline)
             (+ (count-iter (car x))
                (count-iter (cdr x))
                1))))
    (count-iter x))
  (count-pairs-inner x (list x)))

测试

(define l (cons a b))
(define x (cons l l))
(count-pairs-right x) ;; 2
(count-pairs x) ;; 5

3.18

实现一个过程,检查表中是否包含环. 依次检查表中的节点是否与表头相等即可.

(define (is-cycle? arr)
  (define (iter x)
    (cond ((eq? x '()) #f)
          ((eq? x arr) #t)
          (else (iter (cdr x)))))
  (iter (cdr arr)))

测试:

(define c (make-cycle '(a b c)))
(is-cycle? c) ; #t
(is-cycle? '(a b c)) ;#f

3.19

采用常量空间重做3.18..需要一种很聪明的想法(看来我刚才写的一定是朴素的想法了….
3.18的解法为神马不是常量空间呢,因为里面有递归,每次调用iter都将创建一个新环境,复杂度是N. 看来这道题目需要用一种一刀秒的思路来解..
3.13构造的环一定是表尾接表头的,这里就不考虑其它复杂情况了,比如表尾接表第二个节点之类的..
那么我们只要把表第一个节点的cdr设置为nil,然后判断表的剩余部分的最后一个节点是不是第一个节点就可以了(有木有很聪明!

(define (is-cycle? arr)
  (let ((left-arr (cdr arr)))
    (set-cdr! arr '())
    (if (eq? (last-pair left-arr) arr)
        #t
        #f)))

改变也就是赋值

从理论上说,为了表现变动数据的行为,所需要的全部东西也就是赋值.

习题3.20

画出下面表达式求值过程的环境图示

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

E0: [x]
    x = 1, y = 2
    参数: m1
    过程体:(cond (eq? m 'car) ....)
    [z]
    x = [x], y = [x]
    参数: m2
    过程体:(cond (eq? m 'car) ....)
    [car] 过程体..
    [cdr] 过程体..
    [set-car!] 过程体..
    [set-cdr!] 过程体..

对z应用'cdr

E1: m2 = 'cdr
    得到E0中的x

对返回值x应用'set-car!

E2: m1 = 'set-car!
    返回[x]的内部过程(define (set-x! v) (set! x v))

对'set-car!应用17

E3: v = 17
    set改变了E0中[x]的实参x=1的值

对过程x应用'car

E4: m1 = 'car
    返回[x]的实参x的值17

队列的表示

为了减少查找时间,我们用一对指针来表示序列:front-ptr和rear-ptr. 它们分别指向一个常规表中的第一个序对和最后一个序对

(define (make-queue) (cons '() '()))
(define (empty-queue? queue) (null? (front-ptr queue)))
(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (front-queue queue)
  (if (empty-queue? queue)
      (error "FRONT called with an empty queue" queue)
      (car (front-ptr queue))))

(define (insert-queue! queue item)
  (let ((new-pair (cons item '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (else
           (set-cdr! (rear-ptr queue) new-pair)
           (set-rear-ptr! queue new-pair)
           queue))))

(define (delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "DELETE! called with an empty queue" queue))
         (else
          (set-front-ptr! queue (cdr (front-ptr queue)))
          queue)))

习题3.21

产生(() b)这样的输出结果是因为delete过程中没有重新指定rear-ptr的值, 即使把"容器"清空,rear-ptr还是指向最后一次insert进来的那个值,所以队列本身看起来不是空的. 想要达到Ben想要的效果,我们需要重新定义一个打印函数,不输出rear-ptr的值.

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

测试:

(define q (make-queue))
(insert-queue! q 'a)
(insert-queue! q 'b)
(print-queue q)
; val=> (a b)

习题3.22

把队列构造成一个带有局部状态的过程.

(define (make-queue)
  (let ((front '())
        (rear '()))
    (define empty-queue? (null? front))
    (define front-queue
      (if (empty-queue?)
          (error "FRONT called with an empty queue")
          (car front)))
    (define (insert-queue! item)
      (let ((new-pair (cons item '())))
        (cond ((empty-queue?)
               (set! front new-pair)
               (set! rear new-pair))
              (else
               (set-cdr! rear new-pair)
               (set! rear new-pair)))))
    (define delete-queue!
      (cond ((empty-queue?)
             (error "DELETE! called with an empty queue" ))
            (else
             (set! front (cdr front))
            front)))
    (define (print-queue) front)

(define d (make-deque))
((d 'insert-queue!) 1)

习题3.23

实现双端队列.这个问题类似双向列表,我们需要维护头和尾两个指针,并小心的处理边界问题.

(define (make-deque)
  (let ((front '())
        (rear '()))
    (define (empty-queue?) (or (null? front) (null? rear)))
    (define (set-next node nxt)
      (set-car! (cdr node) nxt))
    (define (set-prev node nxt)
      (set-cdr! (cdr node) nxt))
    (define (get-next node) (cadr node))
    (define (get-prev node) (cddr node))
    (define (front-queue)
      (if (empty-queue?)
          (error "FRONT called with an empty queue")
          (car front)))
    (define (front-insert-queue! item)
      (let ((new-pair (cons item (cons '() '()))))
        (cond ((empty-queue?)
               (set! front new-pair)
               (set! rear new-pair))
              (else
               (set-next new-pair front)
               (set-prev front new-pair)
               (set! front new-pair)
               ))
        (print-queue)
        ))
    (define (rear-insert-queue! item)
        (let ((new-pair (cons item (cons '() '()))))
        (cond ((empty-queue?)
               (set! front new-pair)
               (set! rear new-pair))
              (else
               (set-prev new-pair rear)
               (set-next rear new-pair)
               (set! rear new-pair)
               ))
        (print-queue)
        ))
    (define (front-delete-queue!)
      (cond ((empty-queue?)
             (error "DELETE! called with an empty queue" ))
            (else
             (set! front (get-next front))
             (cond ((empty-queue?)
                    (display "Now the queue is empty"))
                   (else
                    (set-prev front '())))))
      (print-queue))
    (define (rear-delete-queue!)
      (cond ((empty-queue?)
             (error "DELETE! called with an empty queue" ))
            (else
             (set! rear (get-prev rear))
             (cond ((empty-queue?)
                    (display "Now the queue is empty"))
                   (else
                    (set-next rear '())))))
      (print-queue))
    (define (print-queue)
      (define (print-iter p)
        (cond ((not (null? p))
               (display (car p))
               (display " ")
               (print-iter (car (cdr p))))))
      (print-iter front))
    (define (dispatch m)
      (cond ((eq? m 'front-insert-queue!)
             front-insert-queue!)
            ((eq? m 'rear-insert-queue!)
             rear-insert-queue!)
            ((eq? m 'front-delete-queue!)
             front-delete-queue!)
            ((eq? m 'rear-delete-queue!)
             rear-delete-queue!)
            ((eq? m 'print-queue)
             (print-queue))
            ))
    dispatch))
;; Test
(define d (make-deque)) ; -> d
((d 'front-insert-queue!) 1) ; -> 1
((d 'front-insert-queue!) 2) ; -> 2 1 
((d 'front-insert-queue!) 3) ; -> 3 2 1
((d 'rear-insert-queue!) 3) ; -> 3 2 1 3
((d 'front-delete-queue!)) ; -> 2 1 3
((d 'rear-delete-queue!)) ; -> 2 1
(d 'print-queue)

表格的表示

一维表格

在一维表格中,每个值保存在一个关键码之下.

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

(define (assoc key records)
  (cond ((null? records) false)
        ((equal? key (caar records)) (car records))
        (else (assoc key (cdr records)))))

(define (insert! key value table)
  (let ((record (assoc key (cdr table))))
    (if record
        (set-cdr! record value)
        (set-cdr! table
                  (cons (cons key value) (cdr table))))))

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

两维表格

两维表格中的每个值由两个关键码索引.

(define (make-table)
  (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 t (make-table))
((t 'insert-proc!) 'a1 'b1 1)
((t 'lookup-proc) 'a1 'b1)

习题3.24

实现一个允许数值误差的比较过程same-key?

(define (same-key? a b range)
  (if (and (number? a) (number? b))
      (and (>= a (- b range)) (<= a (+ b range)))
      (eq? a b)))