SICP-CH2-构造数据抽象

1. 数据抽象索引
2. 层次性数据和闭包性质
3. 抽象数据的多重表示

1 数据抽象索引

数据抽象 是一种科学方法,它使我们能将一个复合数据对象的使用,与该数据对象怎样由更基本的数据对象构造起来的细节隔离开.

1.1 实例:有理数的算术运算

表数据结构 从序对构造起来的数据对象

关键字:cond, car, cdr

定义有理数过程:

;; 定义有理数并用gcd优化
(define (make-rat n d)
  (let ((g (gcd n d)))
    (cons (/ n g)  (/ d g))))
;; 分子
(define (number x) (car x))
;; 分母
(define (denom x) (cdr x))
;; print
(define (print-rat x)
  (newline)
  (display (number x))
  (display "/")
  (display (denom x)))
;; test val->1/2
(print-rat (make-rat 2 -4))

1.2 习题2.1

(define (make-rat n d)
  (let ((g (gcd (abs n) (abs d))))
    (cond ((> (* n d) 0)
           (cons (/ (abs n) g)  (/ (abs d) g)))
          (else  (cons (- 0 (/ (abs n) g)) (/ (abs d) g))))))

1.3 抽象屏障

数据抽象的基本思想是:为每一类数据对象标识出一组操作,使得对这类数据对象的操作都可以基于它们表述,并且只使用它们.

1.4 习题2.2

(define (make-point x y) (cons x y))
(define (x-point x) (car x))
(define (y-point x) (cdr x))
(define (make-segment x y) (cons x y))
(define (start-point x) (car x))
(define (end-point x) (cdr x))
(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

(define (mid-point segment)
  (print-point (make-point
   (/ (+ (x-point (start-point segment)) (x-point (end-point segment))) 2)
   (/ (+ (y-point (start-point segment)) (y-point (end-point segment))) 2))))

(mid-point (make-segment (make-point 1.0 1.0) (make-point 4 5)))
;; value-> (2.5,3.)

1.5 习题2.3

(define (double x) (* x x))
(define (make-rect p1 p2 p3)
  (cons (make-segment p1 p2) (make-segment p2 p3)))
(define (h-side rect) (car rect))
(define (v-side rect) (cdr rect))
(define (lenth seg)
  (let ((p1 (x-point seg))
        (p2 (y-point seg)))
  (sqrt
   (+
    (double (- (x-point p1) (x-point p2)))
    (double (- (y-point p1) (y-point p2)))))))
(define (rect-length rect)
  (* (+
      (lenth (h-side rect))
      (lenth (v-side rect)))
     2))
(define (rect-area rect)
  (*  (lenth (h-side rect))
      (lenth (v-side rect))))

;; test
(lenth (make-segment (make-point 1 1) (make-point 2 2))) 
;Value: 1.4142135623730951

(rect-length
 (make-rect (make-point 1 1) (make-point 2 2) (make-point 0 2))) 
;Value: 6.82842712474619

(rect-area
 (make-rect (make-point 1 1) (make-point 2 2) (make-point 0 2))) 
;Value: 2.8284271247461903

1.6 数据意味着什么

数据 是一组适当的 构造函数 和 选择函数 ,以及为了使这些过程成为一套合法的表示, 它们必须满足的一组*特定条件*

条件可能不太好理解, 举例来说, 序对这种数据的car和cdr操作需要满足的条件就是: 任何对象x和y, 如果z是(cons x y),那么(car z)就是x, (cdr z)就是y.

数据的过程性表示 lisp/scheme甚至可以用过程来表示序对:

(define (cons x y)
 (define (dispatch m)
   (cond ((= m 0) x)
         ((= m 1) y)
         (else (error "argument not 0 or 1")))
  dispatch))

(define (car z) (z 0))
(define (cdr z) (z 1))

(cons x y)返回一个过程. 当然scheme和一般的lisp并不会这样实现序对,主要是出于性能考虑.

在第三章可以看到,数据的过程性表示在设计中扮演着一种重要的角色,这种风格叫做 消息传递

1.7 习题2.4

代换过程:

(car (cons x y))
((cons x y) (lambda (p q) p))
;把(lambda (p q))作为m带入(lambda (m) (m x y))
((lambda (p q) p) x y)
;应用x,y,得到
value->x

1.8 习题2.5

2和3都是质数,可以利用质数相乘的性质储存a和b.

(define (cons-expt x y)
  (* (expt 2 x) (expt 3 y)))

(define (car-expt x)
  (define (iter a n)
    (cond ((= 0 (remainder a 2)) (iter (/ a 2) (+ n 1)))
          (else n)))
  (iter x 0))

(define (cdr-expt x)
  (define (iter a n)
    (cond ((= 0 (remainder a 3)) (iter (/ a 3) (+ n 1)))
          (else n)))
  (iter x 0))

(car-expt (cons-expt 5 6)) ;value->5
(cdr-expt (cons-expt 5 6)) ;value->6

1.9 习题2.6

使用church计数的表示形式定义one和two. (讲真我对着这道题发呆好久….

(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
  (lambda (f) (lambda (x) (f (n f) x))))

; 首先展开add-1
(add-1 zero)
(lambda (f) (lambda (x) (f ((zero f) x))))
(lambda (f) (lambda (x) (f ((lambda(x) x) x))))
(lambda (f) (lambda (x) (f x)))
(add-1 one)
(lambda (f) (lambda (x) (f ((one f) x))))
(lambda (f) (lambda (x) (f ((lambda (x) (f x)) x))))
(lambda (f) (lambda (x) (f (f x))))
; 定义one
(define one (lambda (f) (lambda (x) (f x))))
; 定义two
(define two (lambda (f) (lambda (x) (f (f x)))))
;根据观察得出规律规律:one的定义中应用了一次f, two的定义中应用了2次f, 所以这类过程可以理解为用'应用f的次数'来表示数字.

定义通用的加法:

(define (add a b)
  (lambda(f) (lambda(x) ((a f) ((b f) x)))))

这个定义的思路是把a和b中应用f的过程叠加. 下面测试一下:

(add one two)
(lambda(f) (lambda(x) ((lambda(x) (f x)) ((lambda(x) (f (f x))) x))))
(lambda(f) (lambda(x) ((lambda(x) (f x)) (f (f x)))))
(lambda(f) (lambda(x) (f (f (f x)))))

1.10 扩展练习:区间算术

1.11 习题2.7

(define (make-interval a b) (cons a b))
(define (upper-bound x) (car x))
(define (lower-bound x) (cdr x))

1.12 习题2.8

(define (sub-interval a b)
  (make-interval (- (upper-bound a) (upper-bound b))
                 (- (lower-bound a) (lower-bound b))))

1.13 习题2.9

对加/减运算而言: $w(a+b)=(u(a+b)-l(a+b))/2=(((u(a)+u(b))-(l(a)+l(b)))/2=(w(a)+w(b))$ 所以两个区间的和/差的宽度函数就是被加/减的区间的宽度函数.

对乘法而言:

有区间A=[0,2],宽度为1;B=[0,4],宽度为2; A*B=[0,8],宽度为4. 所以$w(A*B)\neq w(A)*w(B)$.

对除法而言: A/B=[0,1/2],宽度为1/4. 而w(A)/w(B)=1/2; 所以$w(A/B)\neq w(A)/w(B)$.

1.14 习题2.10

; 首先定义一个检查过程
(define (valid-interval x)
  (if (< (* (upper-bound x) (lower-bound x)) 0) false true))
; 重新定义除法
(define (div-interval x y)
  (if (and (valid-interval x) (vali-interval y))
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))
      (display "error:invalid param")))

1.15 习题2.11

根据区间是否跨过0|是否全为正|是否全为负分为9种情况.

a > 0, b > 0
a > 0, b < 0
a > 0, b cross 0
a cross 0, b > 0
a cross 0, b < 0
a cross 0, b cross 0
a < 0, b > 0
a < 0, b < 0
a < 0, b cross 0

定义快速乘法(有个问题..当a和b都跨越0时,需要4次乘法运算)

(define (is-cross-zero x)
  (if (< (* (upper-bound x) (lower-bound x)) 0) true false))
(define (is-positive x)
  (if (>= (lower-bound x) 0) true false))
(define (is-negative x)
  (if (< (upper-bound x) 0) true false))

(define (fast-mul-interval x y)
  (cond
   ((and (is-positive x) (is-positive y))
    (make-interval
     (* (lower-bound x) (lower-bound y))
     (* (upper-bound x) (upper-bound y))))
   ((and (is-positive x) (is-negative y))
    (make-interval
     (* (upper-bound x) (upper-bound y))
     (* (lower-bound x) (lower-bound y))))
   ((and (is-positive x) (is-cross-zero y))
    (make-interval
     (* (upper-bound x) (lower-bound y))
     (* (upper-bound x) (upper-bound y))))
   ((and (is-negative x) (is-positive y))
    (make-interval
     (* (lower-bound x) (upper-bound y))
     (* (upper-bound x) (lower-bound y))))
   ((and (is-negative x) (is-negative y))
    (make-interval
     (* (upper-bound x) (upper-bound y))
     (* (lower-bound x) (lower-bound y))))
   ((and (is-negative x) (is-cross-zero y))
    (make-interval
     (* (lower-bound x) (upper-bound y))
     (* (lower-bound x) (lower-bound y))))
   ((and (is-cross-zero x) (is-positive y))
    (make-interval
     (* (lower-bound x) (upper-bound y))
     (* (upper-bound x) (upper-bound y))))
   ((and (is-cross-zero x) (is-negative y))
   (make-interval
    (* (upper-bound x) (lower-bound y))
    (* (lower-bound x) (lower-bound y))))
  ((and (is-cross-zero x) (is-cross-zero y))
   (make-interval
    (min (* (lower-bound x) (upper-bound y)) (* (upper-bound x) (lower-bound y)))
    (max (* (upper-bound x) (upper-bound y)) (* (lower-bound x) (lower-bound y)) )))))

与Alyssa的暴力乘法进行比较测试(吐血…

(fast-mul-interval (make-interval 1 2) (make-interval 1 2))
(mul-interval (make-interval 1 2) (make-interval 1 2))
;; Value : (1 . 4)

(fast-mul-interval (make-interval 1 2) (make-interval -1 -2))
(mul-interval (make-interval 1 2) (make-interval -1 -2))
;; Value : (-4 .-1)

(fast-mul-interval (make-interval 1 2) (make-interval -1 2))
(mul-interval (make-interval 1 2) (make-interval -1 2))
;; Value : (-2, 4)

(fast-mul-interval (make-interval -2 -1) (make-interval 1 2))
(mul-interval (make-interval -2 -1) (make-interval 1 2))
;; Value : (-4, -1)

(fast-mul-interval (make-interval -2 -1) (make-interval -2 -1))
(mul-interval (make-interval -2 -1) (make-interval -2 -1))
;; Value : (1, 4)

(fast-mul-interval (make-interval -2 -1) (make-interval -1 2))
(mul-interval (make-interval -2 -1) (make-interval -1 2))
;; Value : (-4, 2)

(fast-mul-interval (make-interval -2 1) (make-interval 1 2))
(mul-interval (make-interval -2 1) (make-interval 1 2))
;; Value : (-4, 2)

(fast-mul-interval (make-interval -2 1) (make-interval -2 -1))
(mul-interval (make-interval -2 1) (make-interval -2 -1))
;; Value : (-2, 4)

(fast-mul-interval (make-interval -2 1) (make-interval -5 2))
(mul-interval (make-interval -2 1) (make-interval -5 2))
;; Value : (-5, 10)

1.16 习题2.12

(define (make-center-percent center percent)
  (make-interval (- center (* center percent))
                 (+ center (* center percent))))
(define (percent range)
  (let ((width (/ (- (upper-bound range) (lower-bound range)) 2))
        (mid (/ (+ (upper-bound range) (lower-bound range)) 2)))
        (/ width mid)))

1.17 习题2.13

计算精度的公式是简单相加:

(define (percent-mul r1 r2)
  (+ (percent r1) (percent r2)))

测试一下

(percent (mul-interval (make-interval 9.99 10.01) (make-interval 9.99 10.01)))
(percent-mul (make-interval 9.99 10.01) (make-interval 9.99 10.01))

然后分析part1,part2的问题:

(define (part1 r1 r2)
  (div-interval (mul-interval r1 r2)
                (add-interval r1 r2)))
(define (part2 r1 r2)
  (let ((one (make-interval 1 1)))
    (div-interval one
                  (add-interval (div-interval one r1)
                                (div-interval one r2)))))

(part1 (make-interval 1 2) (make-interval 1 2)) ;val-> (.25,2)
(part2 (make-interval 1 2) (make-interval 1 2)) ;val-> (.5 1)

猜测是运算顺序不同导致精度变化不同

1.18 习题2.14

首先验证上面的猜测

(let ((r1 (make-interval 1.0 2))
       (r2 (make-interval 1.0 2))
      (one (make-interval 1.0 1.0)))
  (percent r1)  ; .33
  (percent (mul-interval r1 r2)) ; .6 放大2倍
  (percent (div-interval r1 r2)) ; .6 放大2倍
  (percent (add-interval r1 r2)) ; .33 不变
  (percent (div-interval one r1)) ; .33 不变
  (percent (part1 r1 r2)) ; .77 放大2.28倍
  (percent (part2 r1 r2)) ; .33 
  )

可见,直接对两个区间进行乘法或除法操作会将精度放大.而加法以及被one除不会放大精度.

在part1的运算过程中,乘法将精度放大2倍, 用放大的乘积除以和之后从0.6放大到0.77. 而在part2中,由于全是除以1的操作.精度没有发生变化.

1.19 习题2.15

eva说的对. part2中的运算都没有造成精度区间扩大,所以是更好的程序.

1.20 习题2.16

(作者说此题非常难…怕

我先想到了除法运算可能长这样:

(define (better-div-interval r1 r2)
  (let ((one (make-interval 1 1)))
    (better-mul-interval r1  (div-interval one r2))))

但首先要能定义出一个better-mul-interval

我实在编不下去了! google了一下,这道题真的很难,涉及到比较艰深的数学问题. 贴个链接在这里吧: http://stackoverflow.com/questions/14130878/sicp-2-16-interval-arithmetic-scheme

2 层次性数据和闭包性质

操作的闭包性质 通过某种操作组合起来的数据对象得到的结果本身还可以通过同样的操作再进行组合.

2.1 序列的表示

序列可以通过嵌套cons操作构造起来

(cons 1
    (cons 2
        (cons 3
            (cons 4 ))))

scheme为了方便表的构造而提供了一个基本操作list.所以上面序列也可以通过以下方式产生:

(list 1 2 3 4)

它们是等价的.

2.1.1 对表的操作

car 可以被看做获取表第一项元素的操作 cdr 可以看做获取表剩下的元素的操作 nil 用于表示序对链的结束

可以这样实现索引:

(define (list-ref item n)
  (if (= n 0)
      (car item)
      (list-ref (cdr item) (- n 1))))

null? 用于检查是否是空表. 利用null实现length:

(define (length items)
  (if (null? items)
      0
      (+ 1 (length (cdr items)))))

2.1.2 习题2.17

获取序列的最后一个元素

(define (last-pair items)
  (if (= 1 (length items))
      (list (car items))
      (last-pair (cdr items))))

2.1.3 习题2.18

返回逆序序列

(define (reverse items)
  (if (= 1 (length items))
      items
      (append (reverse (cdr items)) (list (car items)))))

2.1.4 习题2.19

利用序列优化1.22的找硬币程序,把币种存储在序列中

(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))
(define (except-first-denomination coin-values) (cdr coin-values))
(define (first-denomination coin-values) (car coin-values))
(define (no-more? coin-values) (if (null? coin-values) true false))
(define (cc amount coin-values)
  (cond ((= amount 0 ) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

币种的排序不会影响结果.因为针对每种硬币,都会从总金额amount开始重新计算, 测试结果是互相独立的.

2.1.5 习题2.20

这道题说明了scheme怎样定义带有任意多参数的过程

具体方式是使用点尾:

(define (f x y . z) <body>)

那么如果求值(f 1 2 3 4 5),则x=1,y=2,然后z=(3,4,5),是一个list. (原来是这样…

请用这种记法写出same-parity:返回与其第一个参数有同样奇偶性质的表

;首先定义一个选择器,它接受一个过程参数f,然后用f来过滤出子序列
(define (filter items f)
  (cond
   ((null? items) (list))
   ((f (car items))
    (append (list (car items)) (filter (cdr items) f)))
   (else
    (append (list) (filter (cdr items) f)))))

然后定义same-party.为了简化我首先利用append把x,y,z整合成一个序列

(define (same-party x y . z)
  (let ((param-list
         (append (list x) (append (list y) z))))
    (if
     (odd? x)
     (filter param-list odd?)
     (filter param-list even?))))

测试

(same-party 2 1 2 3 4 5 6 7 8) ; value: (1 3 5 7)
(same-party 1 2 3 4 5 6 7 8)   ; value: (2 2 4 6 8)

2.1.6 对表的映射

map 是一种公共模式,而且建立起了一种处理表的高层抽象

(define (map proc items)
  (if (null? items)
      (list)
      (cons (proc (car items))
            (map proc (cdr items)))))

2.1.7 习题2.21

(define (square-list items)
  (if (null? items)
      '()
      (cons (square (car items)) (square-list (cdr items)))))

(define (square-list items)
  (map square items))

2.1.8 习题2.22

第一个迭代错在cons的顺序,把answer放在最后会变成倒序

(cons (...) answer)

而修改后的程序把answer放在前面,虽然看起来顺序对了,但cons的第一个参数是嵌套的cons,最后生成的序列会长这样:

((((. .) .) .) .)

2.1.9 习题2.23

实现一个for-each

(define (for-each proc items)
  (if (null? items)
       ()
       (begin
         (proc (car items))
         (for-each proc (cdr items)))))

2.2 层次结构

将表作为序列的方式,可以自然的推广到表示那些元素本身也是序列的序列,也就是 树.

pair? scheme提供的基本过程, 检查参数是否为序对.

2.2.1 习题2.24

(list 1 (list 2 (list 3 4) 5))
;Value 89: (1 (2 (3 4) 5))

2.2.2 习题2.25

(cdr (car (cdr (cdr mt1))))
(cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr mt2)))))))))))

2.2.3 习题2.26

(append x y) ;Value 101: (1 2 3 4 5 6)
(cons x y)   ;Value 102: ((1 2 3) 4 5 6)
(list x y)   ;Value 103: ((1 2 3) (4 5 6))

2.2.4 习题2.27

实现深度逆序.这道题目真是折腾死宝宝了,一开始有个关键点没搞明白,导致瞎写了一通. 这个关键的地方是:如果(cdr list)是一个list:

(list 1 (list 2 3))

那么它的逆序则是

(append (cdr list) (car list))

但如果(car list)是list,就稍微有点绕:

(list (list 1 2) 3)

那么它的逆序则是

(append (cdr list) (list (car list)))

原因是append或者cons会把第二个参数展开(去掉一层list), 所以不能直接使用(car x)当做第二个参数.

深度逆序:

(define (deep-revers tree)
  (cond
   ((null? tree) ())
   ((not (pair? tree)) (list tree))
   ((pair? (car tree))
      (append (deep-revers (cdr tree)) (list (deep-revers (car tree)))))
   (else
      (append (deep-revers (cdr tree)) (deep-revers (car tree))))))

2.2.5 习题2.28

(define (fringe tree)
  (cond
   ((null? tree) ())
   ((not (pair? tree)) (list tree))
   (else
    (append (fringe (car tree))
            (fringe (cdr tree)))
        )))

2.2.6 习题2.29

-a) 获取左右子树,右子树稍稍注意:

(define (make-mobile left right)
  (list left right))
(define (make-branch length structure)
  (list length structure))
(define (left-branch mobile)
  (car mobile))
(define (right-branch mobile)
  (car (cdr mobile)))

b) 递归计算子树长度(左边叶子之和)

(define (branch-length branch)
  (cond
   ((null? branch) 0)
   ((not (pair? branch)) 0)
   (else
    (+ (car branch) (branch-length (right-branch branch))))))

递归计算重量(右叶子之和)

(define (branch-weight branch)
  (cond
   ((null? branch) 0)
   ((not (pair? branch)) branch)
   (else
    (branch-weight (right-branch branch)))))

(define (total-weight mobile)
  (+
   (branch-length (left-branch mobile))
   (branch-length (right-branch mobile))))

c) 计算是否平衡,简单的乘法.

(define (is-balance mobile)
  (=
   (* (branch-weight (left-branch mobile)) (branch-length (left-branch mobile)))
   (* (branch-weight (left-branch mobile)) (branch-length (right-branch mobile)))))

d) 只需修改right-branch方法

(define (right-branch mobile)
  (cdr mobile))

2.2.7 对树的映射

把map与递归结合是处理树的一种强有力的抽象

2.2.8 习题2.30

定义square-tree

(define (map-tree tree f)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (map-tree sub-tree f)
             (f sub-tree)))
       tree))
(map-tree (list 1 2 (list 3 4)) square)
; value: (1 4 (9 16))

2.2.9 习题2.31

将2.30进一步抽象. (还好宝宝机智,已经抽象好了

(define (square-tree tree) (map-tree tree square))

2.2.10 习题2.32

计算全排列(又学到一种算排列的新姿势

(define (subsets s)
  (if (null? s)
      ()
      (let ((reset (subsets (cdr s))))
        (append reset
                (cons
                 (car s) 
                 (map (lambda (sub) (append (car s) sub)) reset))))))

倒数第3行用cons比较安全. 如果(map..)计算结果是nil, 则cons会把nil省略而list或append会把()放进结果中. 作这道题一开始append结果总跟预想的不一样,经测试(append 1 2)的结果是个序对(1 . 2)而不是list(1 2). 后来修改了之前的append实现才搞定:

(define (append list1 list2)
  (cond ((null? list1)
         list2)
        ((null? list2) ;; 对list2=nil的情况进行处理
         list1)
        ((and (not (pair? list1)) (not (pair? list2)))
         (list list1 list2)) ;; 两个都是简单数据时返回list,而不是序对
        ((not (pair? list1))
         (cons list1 list2)) ;; list1是简单数据时直接cons,否则后面会对它car/cdr
        (else
         (cons (car list1) (append (cdr list1) list2)))))

2.3 序列作为一种约定的界面

这里介绍与数据结构有关的另一种强有力的设计原理 使用约定的界面.

举个例子,定义一个过程,枚举所有叶子,并计算出那些值为奇数的叶子的平方和. 这个过程可以抽象成一个信号流:

enumerate:	filter:	map:	accumulate:
tree leaves	odd?	square	+, 0

如果我们能良好的组织成熟,使得 信号流结构 明显的表现在写出的过程中,将会大大提高代码的清晰性.

2.3.1 序列操作

要清晰的反应信号流结构, 最关键的一点就是将注意力集中在处理过程从一个步骤流向下一个步骤的"信号".

map 可以利用2.2.1节的map来表现信号流图中的映射步骤.

(map square (list 1 2 3 4 5)

filter

(define (filter predicate sequence)
  (cond ((null? sequence) ())
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

accumulate 定义计算步骤

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

enumerate 定义树的枚举

(define (enumerate-tree tree)
  (cond ((null? tree) ())
        ((not (pair? tree)) (list tree))
        (else (append (enumerate-tree (car tree))
                      (enumerate-tree (cdr tree))))))

利用这些步骤来定义前面的例子:

(define (sum-odd-squares tree)
  (accumulate +
              0
              (map square
                   (filter odd?
                           (enumerate-tree tree)))))

这样我们就得到了一个由许多独立程序片段组合构成的设计.

2.3.2 习题2.33

(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) () sequence))
(define (append seq1 seq2)
  (accumulate cons seq2 seq1))
(define (length sequence)
  (accumulate (lambda (x y) (+ y 1)) 0 sequence))

2.3.3 习题2.34

(define (horner-eval x sequence)
  (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
              0
              sequence))

(horner-eval 2 (list 1 3 0 5 0 1));Value: 79

2.3.4 习题2.35

(define (count-leaves t)
  (accumulate (lambda (x y) (+ x y))
              0
              (map (lambda (x) (length (enumerate-tree x))) t)))
(count-leaves (list 1 2 (list 2 3 4))) ; Value:5

2.3.5 习题2.36

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      ()
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

(accumulate-n + 0 (list (list 1 2 3) (list 1 2 3)))

2.3.6 习题2.37

实现矩阵点的各种基本运算

(define (dot-product v w)
  (accumulate + 0 (accumulate-n * 1 (list v w))))

(define (matrix-*-vector m v)
  (map
   (lambda (x) (dot-product x v))
   m))
(define (transpose m)
  (accumulate-n (lambda (x y) (cons x y)) () m))
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (col) (matrix-*-vector m col)) cols)))

测试:

(define mv (list 1 2 3))
(define mm (list (list 1 2 3) (list 4 5 6) (list 4 5 6)))
(dot-product mv mv);Value: 14
(matrix-*-vector mm mv);Value 269: (14 32 32)
(transpose mm);Value 266: ((1 4) (2 5) (3 6))
(matrix-*-matrix mm mm);Value 268: ((21 48 48) (27 63 63) (33 78 78))

2.3.7 习题2.38

(fold-right / 1 (list 1 2 3)) ;;Value: 3/2
(fold-left / 1 (list 1 2 3))  ;;Value: 1/6
(fold-right list () (list 1 2 3));Value 270: (1 (2 (3 ())))
(fold-left list () (list 1 2 3));Value 271: (((() 1) 2) 3)

保证fold-right和fold-left都相同的条件是,运算满足交换律.

2.3.8 习题2.39

(define (reverse sequence)
  (fold-right (lambda (x y) (append y (list x))) () sequence))
  (define (reverse sequence)
  (fold-left (lambda (x y) (cons y x)) ()  sequence))

2.3.9 嵌套映射

我们可以扩充序列泛型,将许多通常用嵌套循环表述的计算包含进来, 比如用append累积map的计算结果:

(define (flatmap proc seq)
  (accumulate append (list) (map proc seq)))

ep1: 找出n以下所有和为素数的序对:

(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (flatmap
                (lambda (i)
                  (map (lambda (j) (list i j))
                       (enumerate-interval 1 (- i 1))))
                (enumerate-interval 1 n)
                ))))

ep2: 全排列

(define (permutations s)
  (if (null? s)
      (list (list))
      (flatmap (lambda (x)
                 (map (lambda (p) (cons x p))
                      (permutations (remove x s))))
               s)))
(define (remove item sequence)
  (filter (lambda (x) (not (= x item)))
          sequence))

2.3.10 习题2.40

(define (unique-pairs low high)
  (flatmap (lambda (x) 
         (map (lambda (y) (list x y))
              (enumerate-interval (+ x 1) high)))
           (enumerate-interval low high)))
(unique-pairs 1 3);;=> ((1 2) (1 3) (2 3))
(define (prime-sum-pair n)
  (filter prime-sum? (unique-pairs 1 n)))
(prime-sum-pair 3)

2.3.11 习题2.41

(define (unique-triples low high)
  (flatmap (lambda (x)
             (map (lambda (i) (append x i)) (unique-pairs (+ x 1) high)))
           (enumerate-interval low high)))
(unique-triples 1 4)
(define (prime-sum-triple? list)
  (prime? (+ (car list) (cadr list) (cadr (cdr list)))))
(define (prime-sum-triples n)
  (filter prime-sum-triple? (unique-triples 1 n)))
(prime-sum-triples 4) ;;=> ((1 2 4) (2 3 4))

2.3.12 习题2.42

经典的8皇后问题,回溯法.

(define (queens board-size)
  (define (queen-cols k)
    (if (= 0 k)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
        (queen-cols board-size))

(define empty-board (list))

空棋盘就是nil

(define (adjoin-position new-row k rest-of-queens)
  (cons new-row rest-of-queens))

k其实没有用到,大概留出这个参数是为了便于替换成其它算法.

(define (safe? k positions)
  (define (safe-iter x rest distance)
    (cond ((null? rest) #t)
          ((= x (car rest)) #f)
          ((= distance (abs (- x (car rest)))) #f)
          (else (safe-iter x (cdr rest) (+ distance 1)))))
  (safe-iter (car positions) (cdr positions) 1))
(queens 4);;Value 458: ((3 1 4 2) (2 4 1 3))

遍历rest, 检查相同行中是否存在皇后, 以及对角线是否存在皇后.

2.3.13 习题2.43

2.42解法只需要递归的计算一遍queen-cols,而Reasoner需要递归T遍,导致最后解题事件变成了 $T*board-size$

2.4 实例:一个图形语言

在描述一种语言时,应该将注意力集中在语言的基本原语,它的组合以及抽象手段. 这一图形语言的优美之处,部分在于语言中只有一个元素,称为画家painter.

2.4.1 习题2.44

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (up painter (right smaller smaller)))))

2.4.2 习题2.45

(define (split t1 t2)
  (define (process painter n)
    (if (= n 0)
        painter
        (let ((process painter (- n 1)))
          (let ((part (t2 smaller smaller)))
            (t1 painter part)))))
    (lambda (painter n) (process painter n)))

2.4.3 习题2.46

(define (make-vect x y) (cons x y))
(define (xcor-vect rect) (car rect))
(define (ycor-vect rect) (cdr rect))
(define (add-vect v1 v2)
  (make-vect
   (+ (xcor-vect v1) (xcor-vect v2))
   (+ (ycor-vect v1) (ycor-vect v2))))
(define (sub-vect v1 v2)
  (make-vect
   (- (xcor-vect v1) (xcor-vect v2))
   (- (ycor-vect v1) (ycor-vect v2))))
(define (scale-vect s v)
  (make-vect
   (* s (xcor-vect v))
   (* s (ycor-vect v))))

2.4.4 习题2.47

方案1:

(define (origin-frame frame) (car frame))
(define (edge1-frame frame) (cadr frame))
(define (edge2-frame frame) (caddr frame))

方案2:

(define (origin-frame frame) (car frame))
(define (edge1-frame frame) (cadr frame))
(define (edge2-frame frame) (cddr frame))

2.4.5 习题2.48

(define (make-segment v1 v2) (cons v1 v2))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))

2.4.6 习题2.49

首先定义一堆获取顶点/边/中点的过程…(吐血)…

(define (top-left frame) (add-vect (origin-frame frame) (edge1-frame frame)))
(define (top-right frame) (add-vect
                           (edge2-frame frame)
                           (add-vect (origin-frame frame) (edge1-frame frame))))
(define (bottom-left frame) (origin-frame frame))
(define (bottom-right frame) (add-vect (origin-frame frame) (edge2-frame frame)))

(define (left-mid frame) (add-vect (origin-frame frame)
                                   (scale-vect 0.5 (edge1-frame frame))))
(define (top-mid frame) (add-vect
                         (scale-vect 0.5 (edge2-frame frame))
                         (add-vect (origin-frame frame)
                                   (edge1-frame frame))))
(define (bottom-mid frame) (add-vect (origin-frame frame)
                                     (scale-vect 0.5 (edge2-frame frame))))
(define (right-mid frame) (add-vect
                         (edge2-frame frame)
                         (add-vect (origin-frame frame)
                                   (scale-vect 0.5 (edge1-frame frame)))))

(define (top frame)  (make-segment (top-left frame) (top-right frame)))
(define (left frame) (make-segment (top-left frame) (bottom-left frame)))
(define (right frame) (make-segment (top-right frame) (bottom-right frame)))
(define (bottom frame) (make-segment (bottom-left frame) (bottom-right frame)))

a) 画出框架的4条边,恩..套用前面定义的过程就好了

(define (painter-a f)
  (segments->painter
   (list (left f) (top f) (rignt f) (bottom f))))

b) 画出对角线..还ok

(define (painter-b f)
  (segments->painter
   (list
    (make-segment (bottom-left f) (top-right f))
    (make-segment (bottom-right f) (top-left f)))))

c) 画出各边中点连线. 于是有了上面一堆xx-mid过程..

(define (painter-c f)
  (segments->paiter
   (list
    (make-segment (left-mid f) (top-mid f))
    (make-segment (top-mid f) (right-mid f))
    (make-segment (right-mid f) (bottom-mid f))
    (make-segment (bottom-mid f) (left-mid f)))))

d) 画出wave (此处沉默1分钟…..). 这是体力活无误了, 谁爱写谁写吧….ヾ(･∀･)ﾉ゛

2.4.7 习题2.50

(define (flip-horiz painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

(define (flip-180 painter)
  (transform-painter painter
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 0.0)))

(define (flip-270 painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

2.4.8 习题2.51

(define (below painter1 painter2)
  (let ((split-point (make-vect 0.0 0.5)))
    (let ((paint-top
           (transform-painter painter1
                              split-point
                              (make-vect 1 0.5)
                              (make-vect 0 1)))
          (paint-below
           (transform-painter painter2
                              (make-vect 0 0)
                              (make-vect 1 0)
                              (make-vect 0 0.5))))
      (lambda (frame)
        (paint-top frame)
        (paint-bottom frame)))))

(define (below painter1 painter2)
    (lambda (frame)
            (rotate90
                (beside
                    (rotate270
                        (flip-horiz painter1))
                    (rotate270
                        (flip-horiz painter2))))))

2.4.9 强健的设计语言层次

分层设计 一个复杂的系统应该通过一系列的层次构造出来,为了描述这些层次,需要使用一系列的语言.

2.4.10 练习2.52

a) 给wave加上一条线段

(make-segment (left-mid f) (top-mid f));; 随便加一条线段

b) 修改corner-split的构造模式

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1)))
            (corner (corner-split painter (- n 1))))
        (beside (below painter up)
                (below right corner)))))

c) 修改square-limit

(define (square-limit painter n)
  (let ((squarter (corner-split (flip-horiz painter) n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))

只把原来第二行的painter改成了(flip-horiz painter). 这道题目的意义大概就在于演示"在良好的分层设计下进行修改是很easy的"吧.

2.5 符号数据

这一节将引进任意符号作为数据的功能.

2.5.1 引号

为了能够直接操作符号,我们的语言需要拥有 为数据对象加引号 的能力. 这样就可以将表和符号标记为应该作为 数据对象 看待, 而不是作为应该求值的表达式.

(define a 1)
(define b 2)
(list a b) -> (1 2)
(list 'a b) -> (a 2)
(list 'a 'b) -> (a b)

注意, 引号只是一种将 下一个完整的表达式 用 (quote <expression>)形式包裹起来的语法糖.

基本过程 eq? 可以以两个符号作为参数,检查它们是否为同样的符号.

2.5.2 习题2.53

(list 'a 'b 'c);Value 468: (a b c)
(list (list 'george));Value 469: ((george))
(cdr '((x1 x2) (y1 y2)));Value 473: ((y1 y2))
(cadr '((x1 x2) (y1 y2)));(y1 y2)
(pair? (car '(a short list)));#f
(menq 'red '((red shoes) (blue socks)));#f
(menq 'red '(red shoes blue socks));Value 475: (red shoes blue socks)

2.5.3 习题2.54

(define (equal? x y)
  (cond ((and (not (pair? x)) (not (pair? y))) (eq? x y))
        ((and (pair? x) (pair? y))
         (and (eq? (car x) (car y))
              (equal? (cdr x) (cdr y))))
        (else false)))

2.5.4 习题2.55

根据注释100,'a是(quote a)的语法糖, 所以:

(car ''abracadabra)

等价于

(car '(quote abracadabra))

2.6 实例:符号求导

2.6.1 对抽象数据的求导程序

对于加和乘构造起来的表达式,求导工作可以通过以下几条规约完成:

$\frac{dc}{dx}=0$
$\frac{dx}{dx}=1$
$\frac{d(u+v)}{dx}=\frac{du}{dx}+\frac{dv}{dx}$
$\frac{d(uv)}{dx}=u\frac{dv}{dx}+v\frac{du}{dx}$

假设我们已经有了一些代数运算的基本过程, 那么求导过程可以这样表达

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var)))
        ((product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp))))
        (else
         (error "unknown expression type -- ERIV" exp))))

2.6.2 代数表达式的表示

有关导数问题的数据表示:

; 变量就是符号
(define (variable? x) (symbol? x))
; 两个变量相同
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
; 和式与乘式的构造函数
(define (make-sum a1 a2) (list '+ a1 a2))
(define (make-product m1 m2) (list '* m1 m2))
; 和式就是第一个元素为'+'的表
(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
; 乘式是第一个元素为'*'的表
(define (product? x)
  (and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p) (caddr p))

测试求导过程:

(deriv '(+ x 3) 'x);Value 481: (+ (* x 0) (* 1 y))
(deriv '(* x y) 'x);Value 482: (+ 1 0)

结果是对的,但是没有化简. 为了完成化简,我们需要修改构造函数的实现:

(define (=number? exp num)
  (and (number? exp) (= exp num)))
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list '+ a1 a2))))
(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list '* m1 m2))))

测试

(deriv '(+ x 3) 'x);Value 1
(deriv '(* x y) 'x);Value y
(deriv '(* (* x y) (+ x 3)) 'x);Value 486: (+ (* x y) (* y (+ x 3)))

情况好了一些,但第三个例子还是不太对,所以代数化简是非常非常复杂的问题..这里就不继续深究了..

2.6.3 习题2.56

扩展deriv, 增加对指数的求导功能. 首先定义make-exponention,exponentiation?,base,exponent:

(define (make-exponentiation a1 a2) (list '** a1 a2))
(define (exponentiation? x) (and (pair? x) (eq? (car x) '**)))
(define (base x) (cadr x))
(define (exponent x) (caddr x))

扩充deriv过程,把以下部分加入cond里:

((exponentiation? exp)
         (make-product
          (make-product (exponent exp)
                        (make-exponentiation
                         (base exp)
                         (make-sum (exponent exp) -1)))

测试:

(deriv '(** x 3) 'x);Value 490: (* 3 (** x 2))

2.6.4 习题2.57

扩充求导程序,使之能处理任意项的和与乘积.. 设法只修改和与乘积的表示,不修改deriv.

(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else
         (cond
          ((not (pair? a2)) (cons '+ (append a1 (list a2))))
          (else (cons '+ (append a1 a2)))))))

(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else
         (cond
          ((not (pair? m2)) (cons '* (append m1 (list m2))))
          (else (cons '* (append m1 m2)))))))

2.6.5 习题2.58

a).支持乘法和加法的中缀运算.

(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else
         (cond
          ((not (pair? a2)) (append a1 (append (list '+) (list a2))))
          (else (append a1 (append (list '+) a2)))))))

(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else
         (cond
          ((not (pair? m2)) (append m1 (append (list '*) (list m2))))
          (else (append m1 (append (list '*) m2)))))))
(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))
(define (addend s) (car s))
(define (augend s) (caddr s))
(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))
(define (multiplier p) (car p))
(define (multiplicand p) (caddr p))

修改make-sum和make-product即可, 不需要修改deriv.

b).如果省略不必要的括号, 则必须修改deriv过程,提供处理符号优先级的功能.

2.7 实例:集合的表示

一个集合就是一些不同对象的汇集,利用一组可以用于"集合"的操作来定义他们.这些操作是:

element-of-set? (谓词)
adjoin-set
union-set
intersection-set

2.7.1 集合作为未排序的表

定义element-of-set?

(define (element-of-set? x set)
  (cond ((null? set) false)
        ((equal? x (car set)) true)
        (else (element-of-set? x (cdr set)))))

(define (adjoin-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))

(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) ())
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))

2.7.2 习题2.59

定义union

(define (union set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        ((element-of-set? (car set1) set2)
         (union (cdr set1) set2))
        (else (cons (car set1) (union (cdr set1) set2)))))

测试:

(define s1 (list 1 2 3))
(define s2 (list 2 3 4))
(union s1 s2); (1 2 3 4)

2.7.3 习题2.60

定义可重复集合的基本操作. 首先定义最简单的adjoin,既然集合元素可重复,那么就不必判断element-of-set?了

(define (adjoin-set x set) (cons x set))

element-of-set?只用谓词不能满足后面的需求,要计算x在set中的个数

(define (element-of-set? x set)
  (define (iter x set count)
    (cond ((null? set) count)
          ((equal? x (car set))
                   (iter x (cdr set) (+ count 1)))
          (else (iter x (cdr set) count))))
  (iter x set 0))

交集有点麻烦,在cons时需要借助cons-n过程,计入某个x在set1和set2中的最小个数

(define (cons-n x set n)
  (cond ((= n 0) set)
        (else (cons-n x (cons x set) (- n 1)))))

(define (intersection-set set1 set2)
  (define (iter set1 set2 result)
    (display result)
    (cond ((or (null? set1) (null? set2)) result)
          ((> (element-of-set? (car set1) result) 0)
           (iter (cdr set1) set2 result))
           (else (iter (cdr set1) set2
                 (cons-n
                  (car set1)
                  result
                  (min (element-of-set? (car set1) set1)
                       (element-of-set? (car set1) set2)))))))
  (iter set1 set2 ()))

并集

(define (union set1 set2)
  (define (iter set1 set2 result)
    (cond ((null? set1) result)
          ((null? set2) set1)
          ((> (element-of-set? (car set1) result)
              (element-of-set? (car set1) set1))
           (iter (cdr set1) set2 result))
          (else (iter (cdr set1) set2
                      (cons-n
                       (car set1)
                       result
                       (- (element-of-set? (car set1) set1)
                            (element-of-set? (car set1) result)))))))
  (iter set1 set2 set2))

测试union:

(union '(a a b d d) '(a c d e f))
;Value 555: (d b a a c d e f)

性能比不重复表差,$2*n^2$

2.7.4 集合作为排序的表

加速集合操作的一种方式是给集合 排序. 这样我们就需要某种方式来比较两个元素. 采用有序表以后,element-of-set?就不必扫描整个表了.

(下面这个过程似乎只能判断值是数值类型的集合

(define (element-of-set? x set)
  (cond ((null? set) false)
        ((= x (car set)) true)
        ((< x (car set)) false)
        (else (element-of-set? x (cdr set)))))
(element-of-set 3 (list  2 3 4)) ;; Value: #t

平均而言,这个方法需要检查的步数是$\frac{n}{2}$. 而计算交集只需要O(n)的复杂度

(define (intersection-set set1 set2)
  (if (or (null? set1) (null? set2))
      ()
      (let ((x1 (car set1)) (x2 (car set2)))
        (cond ((= x1 x2)
               (cons x1
                     (intersection-set (cdr set1)
                                       (cdr set2))))
              ((< x1 x2)
               (intersection-set (cdr set1) set2))
              ((< x2 x1)
               (intersection-set set1 (cdr set2)))))))

2.7.5 习题2.61

(define (adjoin-set x set)
  (define (iter x set1 set2)
    (cond ((= x (car set2)) (append set1 set2))
          ((< x (car set2)) (append set1 (append (list x (car set2)) (cdr set2))))
          (else (iter x (append set1 (list (car set2))) (cdr set2)))))
  (iter x () set))

复杂度与二分一样,$\frac{n}{2}$.

2.7.6 习题2.62

(define (union-set set1 set2)
  (define (iter set1 set2 rst)
    (cond ((null? set1) (append rst set1))
          ((null? set2) (append rst set2))
          (else (let ((x1 (car set1)) (x2 (car set2)))
                  (cond
                   ((= x1 x2)
                    (iter (cdr set1) (cdr set2) (append rst (list x1 x2))))
                   ((< x1 x2) 
                    (iter (cdr set1) set2 (append rst (list x1))))
                   ((< x2 x1)
                    (iter set1 (cdr set2) (append rst (list x2)))))))))
  (iter set1 set2 ()))

(union-set '(1 2 2 4) '(2 2 3 4));Value 572: (1 2 2 2 2 3 4 4)

最容易想到的方法当然是利用2.61的adjoin-set啦,但那样的话复杂度又变成 $n^2$ 了.. 所以这里还是利用集合有序的特性,从小到大平行遍历两个集合,这样的复杂度只有n.

2.7.7 集合作为二叉树

如果将集合安排成一棵树的形式,我们还可以得到比排序表更好的结果. 其中每个节点保存一个集合元素,称为该节点的"数据项".

将节点表示为三个元素的表:

(define (make-tree entry left right) (list enrty left right))
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))

element-of-set?和adjoin-set

(define (element-of-set? x set)
  (cond ((null? set) false)
        ((= x (entry set)) true)
        ((< x (entry set))
         (element-of-set? x (left-branch set)))
        ((> x (entry set))
         (element-of-set? x (right-branch set)))))

(define (adjoin-set x set)
  (cond ((null? set) (make-tree x () ()))
        ((= x (entry set)) set)
        ((< x (entry set))
         (make-tree (entry set)
                    (adjoin-set x (left-branch set))
                    (right-branch set)))
        ((> x (entry set))
         (make-tree (entry set)
                    (left-branch set)
                    (adjoin-set x (right-branch set))))))

2.7.8 习题2.63

a) 两个过程对所有的树生成结果都一样, 都是左子树优先遍历.
b) 这两个方法的展开数相同,但第一个方法中每次展开都使用了复杂度为 $n^2$ 的append操作,所以方法一的复杂度比方法2高的多.

2.7.9 习题2.64

首先测试结果

(list->tree '(1 3 5 7 9 11))
;Value 578: (5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))
;画出来长这样:
       5
   1       9
     3   7   11

这个算法利用二分法,递归的从叶子节点开始产生平衡树.上面这个树的计算过程是:

(1 3 5 7 9 11) 
;left-length: 2
(1 3) 5 (7 9 11) 
;left-of-left-tree: 0, left-of-right-tree: 1
(() 1 (3)) 5 ((7) 9 (11))

复杂度:对于每个节点,上述算法只是进行make-tree,也没有额外的遍历, 所以复杂度是 $O(n)$

2.7.10 习题2.65

并集先利用tree->list把一个tree转化成list, 然后利用前面的adjoin-set方法把元素逐个插入第二个tree中.

(define (union-set-tree tree1 tree2)
  (let ((list1 (tree->list tree1)))
    (define (adjoin-list-to-tree list tree)
      (cond ((null? list) tree)
            (else
             (adjoin-list-to-tree (cdr list)
                                  (adjoin-set (car list) tree)))))
    (list->tree (adjoin-list-to-tree list1 tree2))))

交集直接利用tree->list转化成list以后append,再利用list->tree转化回来

(define (intersection-set-tree tree1 tree2)
  (list->tree (intersection-set
               (tree->list tree1)
               (tree->list tree2))))

测试

(union-set-tree (list->tree '(1 3 5)) (list->tree '(2 4)))
;Value 613: ((1 () ()) (2 () ()) ((4 (3 () ()) (5 () ())) () ()))

(intersection-set-tree (list->tree '(1 3 5)) (list->tree '(1 3 5 9 7 11)))
;Value 612: (3 (1 () ()) (5 () ()))

2.7.11 习题2.66

实现对已根据key排序的二叉树查找. 前面定义的entry只有value,所以我们需要构造一个key-value结构的节点及key和value的读取过程.

(define (make-entry key value) (cons key value))
(define (key entry) (car entry))
(define (value entry) (cdr entry))

实现普通的二叉树查找:

(define (loopup x tree)
  (cond ((null? tree) false)
        ((= x (key (entry tree)))
         (value (entry tree)))
        ((< x (key (entry tree))) 
         (loopup x (left-branch tree)))
        ((> x (key (entry tree))) 
         (loopup x (right-branch tree)))))

构造测试数据测试:

(define test-tree (list->tree (list
                               (make-entry 1 "aa")
                               (make-entry 2 "bb")
                               (make-entry 3 "cc")
                               (make-entry 4 "dd")
                               (make-entry 5 "ee")
                               )))
(loopup 3 test-tree) ;Value: "cc"
(loopup 5 test-tree) ;Value: "dd"
(loopup 1 test-tree) ;Value: "aa"

2.8 实例:Huffman编码树

Huffman编码书树简单来说是用于实现 无重复前缀变长编码 的树形结构.

2.8.1 习题2.67

要把本节代码全敲一遍才能算出来的题目….累死宝宝了. 代码太长不贴了, 最终答案是:

(a d a b b c a)

2.8.2 习题2.68

实现加密算法. 步骤大概是从树根开始查找,如果元素在节点左字树的symbols中,则向结果中添加0, 然后继续在左子树中查找, 右子树同理. 如果遇到叶子节点则说明该字符已经加密完成, 而后取下一个字符从根节点开始重新查找. 要实现一个判断节点是否在symbols的过程,并注意处理节点是叶子的情况.

(define (symbol-in-tree? symbol tree)
  (cond ((leaf? tree) (eq? symbol (symbol-leaf tree)))
        (else (memq symbol (symbols tree)))))

(define (encode-symbol message tree)
  (define (encode-iter message subtree result)
    (cond ((null? message) result)
          ((leaf? subtree) (encode-iter (cdr message) tree result))
          (else (let ((left (left-branch subtree))
                 (right (right-branch subtree)))
             (cond ((symbol-in-tree? (car message) left)
                    (encode-iter  message left (cons '0 result)))
                   ((symbol-in-tree? (car message) right)
                    (encode-iter  message right (cons '1 result)))
                   (else (error "sambol not in the tree"))
                   )))))
  (encode-iter message tree ()))

用上一题的加密结果来测试, 答案正确.

(define sample-message '(a d a b b c a))
(encode-symbol sample-message sample-tree)
;Value 643: (0 1 1 1 0 1 0 1 0 0 1 1 0)

2.8.3 习题2.69

这道题目颇费了一些时间…. 关键的技巧是利用有序性, 反复归并前两个元素, 并利用adjoin-set将归并后的节点插入回节点序列.

(define (successive-merge pairs)
  (cond ((= 1 (length pairs)) pairs)
        (else
         (successive-merge
          (adjoin-set
           (make-code-tree (car pairs) (cadr pairs))
           (cddr pairs))))))
;; test
(successive-merge (make-leaf-set (list '(A 4) '(B 2) '(C 1) '(D 1))))
;Value 649: (((leaf a 4) ((leaf b 2) ((leaf d 1) (leaf c 1) (d c) 2) (b d c) 4) (a b d c) 8))

2.8.4 习题2.70

(define sing-pairs (list '(a 2) '(na 16) '(boom 1) '(sha 3) '(get 2) '(yip 9) '(job 2) '(wah 1)))
(define sing-tree (car (successive-merge (make-leaf-set sing-pairs))))
(encode-symbol '(Get a job) sing-tree)
; (0 0 0 0 0 0 0 0 0 1 1 1)
(encode-symbol '(Sha na na na na na na na na) sing-tree)
; (0 1 1 1 1 0 0 1 1 1 1 1 1 1)
(encode-symbol '(Get a job) sing-tree)
; (0 0 0 0 0 0 0 0 0 1 1 1)
(encode-symbol '(Sha na na na na na na na na) sing-tree)
; (0 1 1 1 1 0 0 1 1 1 1 1 1 1)
(encode-symbol '(Wah yip yip yip yip yip yip yip yip yip) sing-tree)
; (0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1)
(encode-symbol '(Sha boom) sing-tree)
; (1 1 0 1 1 0 1 1 1)

共需要84个二进制位. 如果用定长编码,为8个单词的编码,每个单词需要3个二进制位, 总共需要36*3=108个二进制位.

2.8.5 习题2.71

n=5时,频度分别是1,2,4,8,16,树长这样:

                    (a,b,c,d,e) 31
               (a,b,c,d)15     e 16
         (a,b,c) 7      d 8
   (a,b)3        c 4
a 1      b 2

频度最高的符号是e,它是根节点的右子树,编码需要1个二进制位.最不频繁的符号是a,位于树的第(n-1)层,需要4个二进制位. 推广到一般的树,最频繁的符号需要1位,最不频繁的符号需要(n-1)位.

2.8.6 习题2.72

对编码最频繁的符号来说,只需进行2次symbol-in-tree(因为首先计算左子数)即可命中,复杂度是n. 对编码最不频繁的符号来说,需要进行n-1次symbol-in-tree才能命中, 由于查找表逐层递减,总共需要查找 $1+2+..(n-1)=/fracn²/2$次,复杂度是O(n²).

3 抽象数据的多重表示

有时候,对于一个数据对象存在多种不同的表示方式,比如复数就可以表示为两种等价的形式:直角坐标想形式和极坐标形式.

这一节我们将学习如何处理数据,使它们可能在一个程序的不同部分中采用不同的表示方式. 更甚者,我们需要建立抽象屏障去隔离这些不同的设计选择.

实现这种设计的关键是使用 带有类型标识的数据对象, 也就是让数据对象包含着它们应该如何处理的明确的信息.

3.1 复数的表示

沿用在2.1.1节设计有理数包时所采用的同样的数据抽象策略,假定复数运算的实现都包括以下4个选择函数:

real-part
imag-part
magnitude
angle

以及两个构造过程

make-from-real-imag
make-from-mag-ang

3.2 带标志的数据

由选择函数和构造函数形成的抽象屏障,使我们可以把为自己所用的数据对象选择具体表示形式的事情尽量向后推,而且可以保持系统的灵活性.

为了能对带标志的数据进行各种操作,我们将假定有过程 type-tag 和 contents ,它们分别从数据对象中提取出标志和实际内容. 还要有一个过程 attach-tag ,用来生成带标志的数据对象.

(define (attach-tag type-tag contents)
  (cons type-tag contents))

(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "bad tagged datum -- TYPE-TAG" datum)))

(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "bad tagged datum -- CONTENTS" datum)))

(define (rectangular? z)
  (eq? (type-tag z) 'rectangular))

(define (polar? z)
  (eq? (type-tag z) 'polar))

然后使用不同后缀标志不同过程的名字

(define (real-part-polar z)
  (* (magnitude-polar z) (cos (angle-polar z))))

(define (real-part-rectangular z) (car z))

然后用switch-case来实现通用过程real-part.. (为什么感觉switch-case搓搓的..

(define (real-part z)
  (cond ((rectangular? z)
         (real-part-rectangular (contents z)))
        ((polar? z)
         (real-part-polar (contents z)))
        (else (error "Unkown type -- REAL_PART" z))))

这样,实现复数运算时,我们依然可以采用如下形式,因为选择函数是通用的.

(define (add-complex z1 z2)
  (make-from-real-imag (+ (real-part z1) (real-part z2))
                       (+ (imag-part z1) (imag-part z2))))

当通用类型选择polar类型的复数时,它会剥去标志, 只将内容传递给后面的代码. 而当构建一个复数时, 又会加上标志. 这种 剥去和加上标志 的规范方式可以成为一种重要的组织策略.

3.3 数据导向的程序设计和可加性

上一节的实现有一些缺点(就是我吐槽的),switch-case的实现要求通用过程必须知道如何操作每一类数据. 另外,还要保证系统中处理数据的过程不重名. 基于这两点原因,我们说上面的实现不具备 可加性

这一节要进一步将系统设计模块化, 我们叫它 数据导向的程序设计

下面节选一些代码简要说明一下…注意put和get是超前的内容,在3.3.3节中会讲到.

(define (install-rectangular-package)
  ;;internal procedures
  (define (real-part z) (car z))
  ;;interface rest of the system
  (define (tag x) (attach-tag 'rectangular z))
  (put 'real-part '(rectangular) real-part))

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (error
           "No mathod for these type -- APPLY-GENERIC"
           (list op type-tags))))))

(define (real-part z) (apply-generic 'real-part z))

大意就是把数据相关的过程打包存放在一张表里, 以数据类型为key. 用的时候一顿找, 取出相应的过程应用到数据类型.

补充:不实现get和put方法的话后面的习题都无法继续了..所以在这里贴一下代码,测试可用

(define local-table (list '*table*))
(define (assoc key records)
  (cond ((null? records)
         #f)
        ((equal? key (caar records))
         (car records))
        (else
         (assoc key (cdr records)))))
(define (get 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)
              #f))
        #f)))
(define (put 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)

3.3.1 习题2.73

a) 因为number?和same-value这两种逻辑无法用运算符来描述,也就无法放在索引表中.
b) 写出针对和式与积式的求导过程

(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
;; 求导过程
(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        (else
         ((get 'deriv (operator exp)) (operands exp) var))))
;; 安装内部过程
(define (install-deriv-package)
  (define (deriv-sum exp var)
    (make-sum (deriv (car exp) var)
              (deriv (cadr exp) var)))
  (define (deriv-product exp var)
    (make-sum
     (make-product (car exp)
                   (deriv (cadr exp) var))
     (make-product (deriv (car exp) var)
                   (cadr exp))))
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-product))
(install-deriv-package)
;; 测试
(deriv '(+ x 3) 'x)
(deriv '(* x y) 'x)

c) 把乘幂添加到上述系统中

(define (install-deriv-package)
  (define (deriv-sum exp var)
    (make-sum (deriv (car exp) var)
              (deriv (cadr exp) var)))
  (define (deriv-product exp var)
    (make-sum
     (make-product (car exp)
                   (deriv (cadr exp) var))
     (make-product (deriv (car exp) var)
                   (cadr exp))))
  (define (exponentiation exp var)
    (make-product (cadr exp)
                  (make-exponentiation
                   (car exp)
                   (make-sum (cadr exp) -1))))
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-product)
  (put 'deriv '** exponentiation))
(install-deriv-package)
;; test
(deriv '(** x 3) 'x)
; Value: (* 3 (** x 2))

d) 把

(put 'deriv 'operator operation)

改成

(put 'operator 'deriv  operation)

3.3.2 习题2.74

首先需要定义两个方法作为工具,比起前面的put和get,它们多了一个table参数

(define (get-tb table key-1 key-2 )
  (let ((subtable (assoc key-1 (cdr table))))
    (if subtable
        (let ((record (assoc key-2 (cdr subtable))))
          (if record
              (cdr record)
              #f))
        #f)))
(define (put-tb table key-1 key-2 value)
  (let ((subtable (assoc key-1 (cdr 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! table
                  (cons (list key-1
                              (cons key-2 value))
                        (cdr table)))))
  'ok)

(define (employee name)
  (define rst (list '*table*))
  (put-tb rst name 'address 'my-address)
  (put-tb rst name 'salary '999)
  rst)

(define (load-offices)
  (define office-table (list '*table))
  (put-tb office-table 'office-1 'name1 (employee 'name1))
  (put-tb office-table 'office-2 'name2 (employee 'name2))
  (put-tb office-table 'office-2 'name3 (employee 'name3))
  (put-tb office-table 'office-3 'name2 (employee 'name2))
  office-table)

(define offices-record (load-offices))

b) 普通的查询

(define (get-record office name)
  (get-tb offices-record office name))

(define (get-salary office name)
  (define employee (get-tb offices-record office name))
  (if (not employee)
      (error "CANNOT FIND THE EMPLOYEE!")
      (get-tb employee name 'salary)))

(get-record 'office-2 'name2)
(get-salary 'office-1 'name2)

c) 稍微复杂的查询

(define (find-employee-record name)
  (define (iter table name result)
    (if (null? table)
        result
        (let ((subtable (car table)))
          (if (null? subtable)
              result
              (let ((record (assoc name (cddr (cadr subtable)))))
                (if record
                    (iter (cdr table) name (cons result record)
                    (iter (cdr table) name result)))))))
    (iter (cdr offices-record) name '()))

  (find-employee-record 'name3)

d) 在前面load-office方法中添加新条目即可

3.3.3 消息传递

另一种实现智能数据对象的策略是将每一个数据对象表示为一个过程,它以操作的名字作为输入,能够去执行特定的操作.

我们叫它 基于操作名的分派

按照这种思路实现复数(我简化过了..意思传达到即可..

(define (make-from-real-imag x y)
  (define (dispatch op)
    (cond ((eq? op 'real-part) x)
          ((eq? op 'imag-part) y))))

(define (apply-generic op arg) (arg op))

3.3.4 习题2.75

(define (make-from-mag-ang x y)
  (define (dispatch op)
    (cond ((eq? op 'magnitude) x)
          ((eq? op 'angle) y)
          ((eq? op 'real-part) (* x (sin y)))
          ((eq? op 'imag-part) (* x (cons y)))
          (else
           (error "Unknown op -- MAKE FROM MAG ANG" op))))
  dispatch)

3.3.5 习题2.76

基于类型的分派适合需要经常加入新类型的系统,当有变化时向系统中添加一个package即可.

而基于操作名的分派适合经常加入新操作的系统.

3.4 带有通用型操作的系统

上一节教我们定义能够在不同表示上的通用运算包, 这一节教我们定义针对不同参数种类的通用型操作.

3.4.1 通用型算术运算

书本上示例繁杂, 这里仅用add方法来说明吧

首先,通用型算术过程的定义如下:

(define (add x y) (apply-generic 'add x y))

然后安装各种包..

(define (install-scheme-number-package)
  (define (tag x)
    (attach-tag 'scheme-number x))
  (put 'add '(scheme-number scheme-number)
      (lambda (x y) (tag (+ x y))))
   'done)

可以看到,通用型的算术运算是利用内部过程+两层tag来实现的

3.4.2 习题2.77

'complex包中并不存在'magnitude操作,所以返回错误

apply-generic被调用了3次. 过程如下

(magnitude z)
(apply-generic 'magnitude z)
;-> (complex)
(get 'magnitude (complex))
(apply magnitude z)
(apply magnitude (map contents (list z)))
(magnitude '(rectangular 3 4))
(apply-generic 'magnitude '(rectangular 3 . 4))
(map type-tag (list '(rectangular 3 . 4)))                      ; => '(rectangular)
(get 'magnitude '(rectangular))                                 ; => magnitude  ; 这个 magnitude 是定义于 rectangular 包中的 magnitude
(apply magnitude (map contents (list '(rectangular 3 . 4))))    ; => (apply magnitude '((3 . 4)))
(magnitude '(3 . 4))
(sqrt (+ (square (real-part '(3 . 4)))
         (square (imag-part '(3 . 4)))))