层次性数据和闭包性质
- 序对使用的是一种被称为 盒子和指针 的表示方式：
- 序对的每个对象表示为指向 盒子 的 指针;
- 与序对的元素相对应的 盒子 里包含着该元素的表示。
- 用于表示序对的结构实际上是一对方盒，其中左边的方盒里放着序对的 car（指向
car 的指针），右边部分放着相应的 cdr（指向 cdr 的指针）；
- 序对就是一种通用的建筑砌块，通过它可以构造起所有不同种类的数据结构来；
- 建立元素本身也是序对的序对，是 表结构 得以作为一种表示工具的根本基础，这
种能力称为 cons 的 闭包 性质：即组合起数据对象得到的结果本身还可以通过同
样的操作再进行组合，建立起 层次性 的结构；
- 第一章中开始，就提到，组合式的成员本身还可以是组合式，也是闭包性质的一种体
现。
序列的表示
- 在用序对构成的层次性结构的一种链条表示中，最后的一个序对的 cdr 用一个能辨
明不是序对的值表示，标明序列的结束，在程序里用变量 nil 的值；
- 术语 表 专指那些有表尾结束标记的序对的链；相对应的，术语 表结构 指所
有的由序对构造起来的数据结构，而不仅是 表;
(list <a1> <a2> ... <a3>) 等价于 (cons <a1> (cons <a2> (cons
... (cons <an> nil)...))) ;- nil 也可以当作一个不包含任何元素的序列： 空表;
- 嵌套应用 car 和 cdr 可以取出一个表里的第二，第三以及后面的各项，但是使用
起来比较麻烦，提供缩写形式：cadr, 所有这类过程的名字都以 c 开头，以 r 结
束，其中的每个 a 表示一个 car 操作，每个 d 表示一个 cdr 操作，按照它们在
名字中出现的顺序应用；
- 表操作：
- list-ref 返回表中的第 n 项（表元素编号从0开始）；
- null? 检查表是不是空表；
- length 返回表的长度；
- append 以两个表为参数，用它们的元素组合成一个新表；
- 带点尾部记法：在一个过程定义中，如果在形式参数表的最后一个参数之前有一个
点号，那就表明，当这一过程被实际调用时，前面各个形式参数（如果有的话）将
以前面的各个实际参数为值，与平常一样。但最后一个形式参数将以所有剩下的实
际参数的表为值；
- 对表的映射：map
- scheme 内置的 map 以一个取 n 个参数的过程和 n 个表为参数，将这个过程应
用于所有表的第一个元素，而后应用于它们的第二个元素，如此下去，最后返回
所有结果的 表 ；
- map 帮我们建立起了一层抽象屏障，将实现表转换的过程的实现，与如何提取表
中元素以及组合结果的细节隔离开，这种抽象也提供了新的灵活性，使我们有可
能在保持从序列到序列的变换操作框架的同时，改变序列实现的底层细节。
练习 2.17-2.23
2.17
1
2
3
4
5
|
(define (last-pair items)
(let ((left (cdr items)))
(if (null? left)
(car items)
(last-pair left))))
|
2.18
1
2
3
4
5
6
|
(define (reverse items)
(define (iter items result)
(if (null? items)
result
(iter (cdr items) (cons (car items) result))))
(iter items '()))
|
2.19
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))
(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)))))
(define (first-denomination items)
(car items))
(define (except-first-denomination items)
(cdr items))
(define (no-more? items)
(null? items))
;; coin-values 的排列顺序不会影响 cc 给出的回答；
;; 因为代码逻辑上具有一致性，排列顺序的不同只会影响中间结果，不会影响最终的解。
|
2.20
1
2
3
4
5
6
7
8
9
10
11
|
(define (same-parity signal . test)
(define (fetch items p)
(if (null? items)
items
(let ((first (car items)))
(if (p first)
(cons first (fetch (cdr items) p))
(fetch (cdr items) p)))))
(if (even? signal)
(cons signal (fetch test even?))
(cons signal (fetch test odd?))))
|
2.21
1
2
3
4
5
6
7
|
(define (square-list items)
(if (null? items)
'()
(cons (square (car items)) (square-list (cdr items)))))
(define (square-list items)
(map square items))
|
2.22
1
2
3
4
5
6
7
|
;; 主要是因为这条语句：(iter (cdr things) (cons (square (car things)) answer))
;; 这样的话，逻辑上就是把传入的表参数的元素平方以后不停压入结果表，
;; 最后的结果表的元素顺序与需求相反；
;; 第二次修改 (iter (cdr things) (cons answer (square (car things))))
;; 使序对层次结构的最后一个元素不是 nil.
;; 这样计算的结果不但元素顺序没有修正，而且不是合法的‘表’表示了。
|
2.23
1
2
3
4
5
|
(define (for-each proc items)
(if (null? items)
true
(begin (proc (car items))
(for-each proc (cdr items)))))
|
层次性结构
- 序列的元素本身也可以是序列，可以把这样的结构看作是 树 ，而那些本身也是
序列的元素就是形成了树中的 子树 ，往下深入直到序列元素不是序列时，把这种元
素当作树的 叶子;
- 表操作补遗：
- pair? 检查参数是否为序对；
- map 与递归的结合也是处理树的一种强有力的抽象。
练习 2.24-2.32
2.24
1
2
|
;; (1 (2 (3 4)))
;; 盒子指针结构和树结构很容易理解，图示就免了。
|
2.25
1
2
3
4
5
6
7
8
|
;; (1 3 (5 7) 9)
;;(car (cdr (car (cdr (cdr '(1 3 (5 7) 9))))))
;; ((7))
;; (car (car '((7))))
;; (1 (2 (3 (4 (5 (6 7)))))))
;; (cadr (cadr (cadr (cadr (cadr (cadr third))))))
|
2.26
1
2
3
4
5
6
7
|
(define x (list 1 2 3))
(define y (list 4 5 6))
;; (append x y) '(1 2 3 4 5 6)
;; (cons x y) '('(1 2 3) 4 5 6)
;; (list x y) '('(1 2 3) '(4 5 6))
|
2.27
1
2
3
4
5
6
7
8
|
(define (deep-reverse items)
(define (iter items result)
(cond ((null? items) result)
((pair? (car items))
(iter (cdr items)
(cons (deep-reverse (car items)) result)))
(else (iter (cdr items) (cons (car items) result)))))
(iter items '()))
|
2.28
1
2
3
4
5
6
7
8
9
10
11
12
13
|
;; (load "./2.18.scm")
(define (append list1 list2)
(if (null? list1)
list2
(cons (car list1) (append (cdr list1) list2))))
(define (fringe tree)
(define (iter tree result)
(cond ((null? tree) result)
((pair? (car tree)) (iter (cdr tree) (append (fringe (car tree)) result)))
(else (iter (cdr tree) (cons (car tree) result)))))
(reverse (iter tree '())))
|
2.29
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
;; a
(define (make-mobile left right)
(list left right))
(define (make-branch length structure)
(list length structure))
(define (left-branch item)
(car item))
(define (right-branch item)
(car (cdr item)))
(define (branch-length branch)
(car branch))
(define (branch-structure branch)
(car (cdr branch)))
;; b
(define (total-weight item)
(define (recursive item)
(cond ((null? item) 0)
((number? item) item)
(else (+ (recursive (branch-structure (left-branch item)))
(recursive (branch-structure (right-branch item)))))))
(recursive item))
;; c
(define (total-moment item)
(* (branch-length item) (total-weight (branch-structure item))))
(define (balance? item)
(if (not (pair? item))
true
(let ((left (left-branch item)) (right (right-branch item)))
(and (= (total-moment left) (total-moment right))
(balance? (branch-structure left))
(balance? (branch-structure right))))))
;; d
(define (make-mobile-mod left right)
(cons left right))
(define (make-branch-mod length structure)
(cons length structure))
;; just modify right-branch and branch-structure
(define (right-branch-mod item)
(cdr item))
(define (branch-structure-mod branch)
(cdr branch))
|
2.30
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; with map
(define (square-tree tree)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(square-tree sub-tree)
(square sub-tree)))
tree))
;; without map
(define (square-tree-simple tree)
(cond ((null? tree) '())
((not (pair? tree)) (square tree))
(else (cons (square-tree-simple (car tree))
(square-tree-simple (cdr tree))))))
|
2.31
1
2
3
4
5
6
7
8
9
|
(define (tree-map op tree)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(tree-map op sub-tree)
(op sub-tree)))
tree))
(define (square-tree tree)
(tree-map square tree))
|
2.32
1
2
3
4
5
6
7
|
(define (subsets s)
(if (null? s)
(list '())
(let ((rest (subsets (cdr s))))
(append rest (map (lambda (x)
(cons (car s) x))
rest)))))
|
序列作为一种约定的界面
- 将注意力集中在处理过程中从一个步骤流向下一个步骤的“信号”，如果用一些表来
表示这些信号，那么就可以利用表操作实现每一步骤的处理；
- 将程序表示为一些针对序列的操作，这样做的价值就在于能帮助我们得到 模块化
的程序设计，也就是说，得到由一些比较独立的片段的组合构成的设计；
- 模块化结构是控制复杂性的一种威力强大的策略，能形成一个可以 混合和匹配
使用和搭配的标准的程序元素库；
- 在书中，用表实现的序列被作为一种方便的接口，可以利用这种接口去组合去组合
起各种处理模块；
- 而且有了一种统一的数据表示结构，就可以将程序对数据结构的依赖性局限到不多
的数据结构操作上，只要修改这些操作并保持接口约定，就能在数据结构的不同表
示之间切换，并保持程序的整体设计不变。
练习 2.33-2.43
2.33
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(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) (+ 1 y)) 0 sequence))
|
2.34
1
2
3
4
|
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
0
coefficient-sequence))
|
2.35
1
2
|
(define (count-leaves t)
(accumulate (lambda (x y) (+ (length x) y)) 0 (map enumerate-tree t)))
|
2.36
1
2
3
4
5
|
(define (accumulate-n op init seqs)
(if (null? (car seqs))
'()
(cons (accumulate op init (map (lambda (x) (car x)) seqs))
(accumulate-n op init (map (lambda (x) (cdr x)) seqs)))))
|
2.37
1
2
3
4
5
6
7
8
9
10
11
12
|
(define (dot-product v w)
(accumulate + 0 (map * v w)))
(define (martix-*-vector m v)
(map (lambda (x) (dot-product x v)) m))
(define (transpose mat)
(accumulate-n cons '() mat))
(define (martix-*-matrix m n)
(let ((cols (transpose n)))
(map (lambda (v) (martix-*-vector cols v)) m)))
|
2.38
1
2
3
4
5
6
|
;; (fold-left / 1 (list 1 2 3)) 1/6
;; (fold-right /1 (list 1 2 3)) 3/2
;; (fold-right list nil (list 1 2 3)) (1 (2 (3 ())))
;; (fold-left list nil (list 1 2 3)) (((() 1) 2) 3)
;; op should be commutative & associative（自己去网上找详细的解释）
|
2.39
1
2
3
4
5
|
(define (reverse-right sequence)
(accumulate (lambda (x y) (append y (list x))) '() sequence))
(define (reverse-left sequence)
(fold-left (lambda (x y) (cons y x)) '() sequence))
|
2.40
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (prime-sum? pair)
(prime? (+ (car pair) (cadr pair))))
(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (unique-pairs n)
(flatmap
(lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (prime-sum-pairs n)
(map make-pair-sum
(filter prime-sum? (unique-pairs n))))
|
2.41
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
;; (load "2.33.scm")
;; (load "2.40.scm")
(define (filter p s)
(cond ((null? s) '())
((p (car s))
(cons (car s) (filter p (cdr s))))
(else (filter p (cdr s)))))
(define (triple-pair-sum p)
(accumulate + 0 p))
(define (triple-pair n)
(let ((range (enumerate-interval 1 n)))
(flatmap
(lambda (a)
(flatmap
(lambda (b)
(map (lambda (c) (list c b a))
(enumerate-interval (+ b 1) n)))
(enumerate-interval (+ a 1) n)))
range)))
(define (triple-pair-sum-n n s)
(filter
(lambda (p) (= s (triple-pair-sum p)))
(triple-pair n)))
|
2.42
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
;; (load "2.33.scm")
;; (load "2.40.scm")
;; (load "2.41.scm")
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(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 '())
(define (make-position row k)
(list k row))
(define (row-position p)
(cadr p))
(define (k-position p)
(car p))
(define (adjoin-position new-row k rest-of-queens)
(cons (make-position new-row k) rest-of-queens))
(define (get-row positions k)
(cond ((null? (car positions)) (error "invalid operation" k))
((= (k-position (car positions)) k) (row-position (car positions)))
(else (get-row (cdr positions) k))))
(define (safe? k positions)
(if (= k 1)
'true
(let ((r1 (get-row positions k))
(r2 (get-row positions (- k 1))))
(and
(not (= r1 r2))
(not (= (+ 1 r1) r2))
(not (= (+ 1 r2) r1))))))
|
2.43
1
2
|
;; (queens-cols (- k 1)) 的大量重复计算
;; (* (expt n n) T)
|
实例：一个图形语言
写在前面 ：实例本身是演示过程，数据抽象思想，闭包性质和层次性程序设计的一
种手段，练习的主要目的也只是继续强化认知，这里最重要的是知道解题的有效途径
（使用高阶过程，在某一层次如何挑选匹配基本元素等等），而不是答案本身（坐标计
算真的很麻烦，把这个当作次要的、附带的东西）。
- 我们所用的数据在组合方式下的 闭包 性质非常重要，因为这使我们能用不多几
个操作就可以构造出各种复杂的结构；
- 中文版 p93：将画家表示为过程，就在这一图形语言中竖立起一道强有力的抽象屏
障，这就使我们可以创建和混合基于图形能力的各种类型的基本画家，任何过程只
要能取一个框架作为参数(框架位置形状可能不同但框架的组织是不变的)，画出
某些可以伸缩后适合这个框架的东西：
- 比如 p93
segments->painter 就是以相对于单位正方形坐标的线段列表为参
数，在返回的匿名过程内部使用 draw-line 画出线段列表参数映射到框架上
的直线；
- 如脚注94所述，可以推测 rogers painter 应该是以一个相对于单位正方形坐标
的 坐标－灰度序对 列表（表示一个标准灰度图），然后在返回的匿名过程内
部根据传入的画家参数－灰度图，在框架上依次映射坐标并根据灰度着色，就可
以在指定的框架上画出一张肖像图；
- 这一实例展现并发扬了 抽象数据 思想：2.1.3 提到一种有理数表示可以是任
何的东西，只要它能满足适当的条件；这里，一个画家可以以任何方式实现，只
要它能在指定的框架里画出一些东西来；
- 分层设计: 一个复杂的系统应该通过一系列的层次构造出来：
- 构造各个层次的方式，就是设法用各种基本元素组合起作为这一层次中的部件
（中文版翻译问题），而这样构造出的部件又可以作为另一个层次里的基本元素；
- 每个层次上所用的语言都提供了一些基本元素，组合手段，还有对该层次中的适
当细节做抽象的手段；
- 分层设计有助于使程序更加强健，使我们更有可能在给定规范发生一些小改变时，
只需要对程序做少量的修改，分层结构中的每个层次都为表述系统的特征提供了
一套独特词汇，以及一套修改这一系统的方式。
练习 2.44-2.52
2.44
1
2
3
4
5
|
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below painter (beside smaller smaller)))))
|
2.45
1
2
3
4
5
6
|
(define (split arrangement1 arrangement2)
(lambda (painter n)
(if (= n 0)
painter
(let ((smaller ((split arrangement1 arrangement2) painter (- n 1))))
(arrangement1 painter (arrangement2 smaller smaller))))))
|
2.46
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
(define (make-vect x y)
(cons x y))
(define (xcor-vect v)
(car v))
(define (ycor-vect v)
(cdr v))
(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 (divide-vect v1 v2)
(if (or (= 0 (xcor-vect v2)) (= 0 (ycor-vect v2)))
(error "invalid second vector")
(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.47
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
(define (make-frame origin edge1 edge2)
(list origin edge1 edge2))
(define (origin-frame frame)
(car frame))
(define (edge1-frame frame)
(cadr frame))
(define (edge2-frame frame)
(caddr frame))
(define (make-frame origin edge1 edge2)
(cons origin (cons edge1 edge2)))
(define (origin-frame frame)
(car frame))
(define (edge1-frame frame)
(cadr frame))
(define (edge2-frame frame)
(cddr frame))
|
2.48
1
2
3
4
5
6
7
8
9
|
(define (make-segment x y m n)
(cons (make-vect x y)
(make-vect m n)))
(define (start-segment segment)
(car segment))
(define (end-segment segment)
(cdr segment))
|
2.49
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
;; a
(define segment-list1 (list
(make-segment 0 0 0 1)
(make-segment 0 0 1 0)
(make-segment 1 0 1 1)
(make-segment 0 1 1 1)))
(segments->painter segment-list1)
;; b
(define segment-list2 (list
(make-segment 0 0 1 1)
(make-segment 0 1 1 0)))
(segments->painter segment-list2)
;; c
(define segment-list3 (list
(make-segment 0.5 0 0 0.5)
(make-segment 0 0.5 0.5 1)
(make-segment 0.5 1 1 0.5)
(make-segment 1 0.5 0.5 0)))
(segments->painter segment-list3)
;; d
;; 计算坐标重复劳动，没什么意思，就不做了。
|
2.50
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
(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 (rotate180 painter)
(transform-painter painter
(make-vect 1.0 1.0)
(make-vect 0.0 1.0)
(make-vect 1.0 0.0)))
(define (rotate270 painter)
(transform-painter painter
(make-vect 0.0 1.0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0)))
|
2.51
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
(define (below painter1 painter2)
(let ((split-point (make-vect 0.0 0.5)))
(let ((paint-top
(transform-painter painter2
split-point
(make-vect 1.0 0.5)
(make-vect 0.0 1.0)))
(paint-bottom
(transform-painter painter1
(make-vect 0.0 0.0)
(make-vect 1.0 0.0)
split-point)))
(lambda (frame)
(paint-top frame)
(paint-bottom frame)))))
(define (below painter1 painter2)
(rotate90 (beside (rotate270 painter1) (rotate270 painter2))))
|
2.52
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
;; a
;; 没心情算坐标
;; b
(define (corner-split painter n)
(if (= n 0)
painter
(let ((up (up-split painter n))
(right (right-split painter n)))
(beside (below painter up)
(below right (corner-split painter (- n 1)))))))
;; c
(define (square-limit painter n)
(let ((combine4 ((square-of-four flip-vert rotate180
identity flip-horiz))))
(combine4 (corner-split painter n))))
|