「SICP 2.4」数据导向的程序设计模式

切入点：复数的运算、表示和实现

我们将设计一个复数的四则运算系统。（为了精简，下面只以加法、乘法为例演示。）

一般来说可以只用实部+虚部的形式来表示、计算，但是这里不考虑表示形式的问题，混用模+幅角的形式。

1
2
3
4
5
6
7
8
9
(define (+c z1 z2)
  (make-from-real-imag
   (+ (real z1) (real z2))
   (+ (imag z1) (imag z2))))

(define (*c z1 z2)
  (make-from-mag-ang
   (* (mag z1) (mag z2))
   (+ (ang z1) (ang z2))))

对应的构造和选择过程，首先我们用实部+虚部的形式来表现。

下面的 make-from-mag-ang 是指输入一个虚数的模和幅角，返回实部+虚部的表现形式。

而 mag 以及 ang 则通过实部和虚部换算而来。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(define (make-from-real-imag x y) (cons x y))

(define (make-from-mag-ang r a)
  (make-from-real-imag (* r (cos a)) (* r (sin a))))

(define (real z) (car z))

(define (imag z) (cdr z))

(define (mag z)
  (sqrt (+
         (square (real z))
         (square (imag z)))))

(define (ang z)
  (atan
   (imag z)
   (real z)))

简单定义两个测试用例，可以看到 +c 和 *c 已经可以工作了。

需要注意的是，无论源数据是实部+虚部，还是模+幅角，这里的输出结果都是实部+虚部。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(define a (make-from-real-imag 1 2))
(define b (make-from-mag-ang 1 (/ pi 4)))

> (+c a a)
'(2 . 4)
> (*c b b)
'(6.123031769111886e-017 . 1.0)
> (*c a a)
'(-3.0 . 4.000000000000002)
> (+c b b)
'(1.4142135623730951 . 1.414213562373095)
> (+c a b)
'(1.7071067811865475 . 2.7071067811865475)
> (*c a b)
'(-0.7071067811865474 . 2.121320343559643)

但是前面我们说了：不考虑表现形式的问题。也就是说，这个系统应该也可以使用模+幅角的形式表现。

或者说，在实际开发中，常常会遇到一个数据不仅仅只存在一种表现形式。

所以，我们也设计另一套构造和选择函数，并用相同的用例测试。

（注：两个例子中计算出来的值偏差较大，但本文不考虑数学问题，集中在思考程序设计本身。）

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
(define (make-from-mag-ang r a) (cons r a))

(define (make-from-real-imag x y)
  (cons
   (sqrt (+ (square x) (square y)))
   (atan y x)))

(define (mag z) (car z))

(define (ang z) (cdr z))

(define (real z)
  (*
   (mag z)
   (cos (ang z))))

(define (imag z)
  (*
   (mag z)
   (cos (ang z))))

> (+c a a)
'(2.8284271247461907 . 0.7853981633974483)
> (*c a a)
'(5.000000000000001 . 2.214297435588181)
> (+c b b)
'(2.0 . 0.7853981633974483)
> (*c b b)
'(1 . 1.5707963267948966)
> (+c a b)
'(2.4142135623730954 . 0.7853981633974483)
> (*c a b)
'(2.23606797749979 . 1.8925468811915387)

为了解决它们的并存问题，一个方法为使用不同的命名方式避免它们在命名空间中的冲突，比如：

  • make-from-real-imag-rect, make-from-mag-ang-rect, real-rect, imag-rect, mag-rect, ang-rect
  • make-from-real-imag-polar, make-from-mag-ang-polar, real-polar, imag-polar, mag-polar, ang-polar

但是这样简单粗暴的方式并能根治问题，也不正交。

因为，系统要解决的问题之一是允许包含不同的数据实现方式（并且根据原来的形式表示），上面的方式需要修改 +c 和 *c 来适应。但是也代表着在提供操作接口的时候就限制了数据的表现形式。

另外，假设我们希望继续增加表现形式：一方面要注意新的 make-from... 不能重复命名，另一方面操作接口也（可能）要随之改动。

多种表现（和实现）形式的并存

并存问题的解决方式是使用标识，具体来说给不同的实现附加某种标记。
利用这个标记，我们将具体表现的实现“延后”到构造和选择函数的下一层。

而为了保持操作接口的实现不受数据实现的影响，在两者之间增加一层抽象。

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
60
61
62
(define (attach-tag tag content) (cons tag content))

(define tag
  (lambda (x)
    (if (pair? x)
        (car x)
        (error "TAG: " x))))

(define content
  (lambda (x)
    (if (pair? x)
        (cdr x)
        (error "CONTENT: " x))))

(define (make-from-real-imag-rect x y)
  (attach-tag 'rect (cons x y)))

(define (real-rect z) ...)
(define (imag-rect z) ...)
(define (mag-rect z) ...)
(define (ang-rect z) ...)

;; polar 类似，鉴于篇幅不贴出完整代码
;; 下面是操作函数、构造和选择函数之间的抽象层

(define (make-from-real-imag x y)
  (make-from-real-imag-rect x y))

(define (make-from-mag-ang r a)
  (make-from-mag-ang-polar r a))

(define (real z)
  (cond ((rect? z)
         (real-rect (content z)))
        ((polar? z)
         (real-polar (content z)))
        (else
         (error "REAL: " z))))

(define (imag z)
  (cond ((rect? z)
         (imag-rect (content z)))
        ((polar? z)
         (imag-polar (content z)))
        (else
         (error "IMAG: " z))))

(define (mag z)
  (cond ((rect? z)
         (mag-rect (content z)))
        ((polar? z)
         (mag-polar (content z)))
        (else
         (error "MAG: " z))))

(define (ang z)
  (cond ((rect? z)
         (ang-rect (content z)))
        ((polar? z)
         (ang-polar (content z)))
        (else
         (error "ANG: " z))))

上面的改动虽然只是部分解决了问题，但还是带了了好处：

  • 虽然不同的数据实现还是需要避免命名重复，但系统中能并存多种复数表现形式。这样，只要遵循命名规则和相应的 tag ，可以由 George 来做新增实现的代码，我们只需根据约定修改 make... 和 real 等等过程而无需关心它的实现。
  • 类似的，代码将 +c 等操作接口剥离出来，其他程序员只需知道 make-complex, real, mag 等几个接口，就可以自由地去实现更多的复数运算过程。

数据导向：更自动的方式

进一步解决上面的两个问题，我们将使用数据导向的程序设计模式。

首先我们来观察一个表格（第一列是操作名，第一行是类型名）。

rect polar
make-from-real-imag make-from-real-imag + rect make-from-real-imag + polar
make-from-mag-ang make-from-mag-ang + rect make-from-mag-ang + polar
real real + rect real + polar
imag imag + rect imag + polar
mag mag + rect ang + polar
ang ang + rect ang + polar

数据导向的模式就是像上面的表格一样组织函数：

  • 新增一种操作/类型的时候，增加一列/行
  • 调用一个函数的时候按行+列来查找

我们给代码实现这个表格（一种数据结构）和相应的增、查操作。

1
2
3
4
5
6
7
(define table (make-hash))

(define (put op type item)
  (hash-set! table (list op type) item))

(define (get op type)
  (hash-ref table (list op type) #f))

利用实现的这个“表格”，我们对代码进一步改动。（对于 rect 的代码是类似的，就不贴了）

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
(define (install-polar-package)
  ;; internal procedures
  (define (make-from-mag-ang r a)
    (attach-tag 'polar (cons r a)))

  (define (make-from-real-imag x y)
    (attach-tag 'polar
                (cons
                 (sqrt (+ (square x) (square y)))
                 (atan y x))))

  (define (mag z) (car z))

  (define (ang z) (cdr z))

  (define (real z)
    (* (mag z)
       (cos (ang z))))

  (define (imag z)
    (* (mag z)
       (cos (ang z))))
  ;; external apis
  (put 'make-from-mag-ang 'polar make-from-mag-ang)
  (put 'make-from-real-imag 'polar make-from-real-imag)
  (put 'real 'polar real)
  (put 'imag 'polar imag)
  (put 'mag 'polar mag)
  (put 'ang 'polar ang))

首先值得一提的是，这里在定义 make-from-real-imag 这样的过程时已经不加后缀了。然后，我们还需要一些工作将这两个实现用起来。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(install-rect-package)
(install-polar-package)

(define (apply-generic op arg)
  (let ((t (tag arg))
        (proc (get op (tag arg))))
    (if proc
        (apply proc (list (content arg)))
        (error "APPLY-GENERIC: " (list op arg)))))

(define (make-from-real-imag x y) ((get 'make-from-real-imag 'rect) x y))
(define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a))
(define (real z) (apply-generic 'real z))
(define (imag z) (apply-generic 'imag z))
(define (ang z) (apply-generic 'ang z))
(define (mag z) (apply-generic 'mag z))

我们调用一次 (install-xxx-package) ，这样程序才会执行前面写的代码中的 (put ....) ，之后才能从表格中查找和调用内部定义的过程。（值得一提的是，如果不需要某个包，仅仅删掉这一行而无需改动包定义的那端代码，相当方便。）

需要使用哪种类型的哪种操作，就按 (get 操作名 类型名) 来调用（就像先查表格的列，再查行）对应的包里面的内部过程。

至于 apply-generic 是实现更智能的调用，它根据参数的类型自动找到对应的过程（即先查行->后查列的方式查找）。因为加入标识之后的数据实际的表现形式是下面这样的（apply-generic 只是做了解析，而不是硬编码）：

1
2
3
4
5
6
(+c a a)
'(rect 2 . 4)
> (*c b b)
'(polar 1 . 1.5707963267948966)
> (+c a b)
'(rect 1.7071067811865475 . 2.7071067811865475)

「SICP 2.2.4」图像语言

racket 提供了一个包，便于学习和做2.2章里面的图形联系。下面就跟着书中的例子来熟悉这门语言。

基本元素

要使用画图语言，需要在程序前面添加这两行（注意使用DrRacket），以及使用爱因斯坦来替代校长。

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
#lang racket
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

;; 相对于原作里面的 wave，这个包提供了另一个基本图像 einstein
einstein
;; 可以看到它作为一个图像（数据）是以 #procedure 的形式存在的
;; 和前面提到的 过程-数据 混淆的情况一样
;; 需要显式地使用 paint 过程来作画
(paint einstein)

;; 书中的基本例子也运行一遍
(define einstein2 (beside einstein (flip-vert einstein)))
(define einstein4 (below einstein2 einstein2))
(paint einstein2)
(paint einstein4)

;; 像一般过程（数据）一样抽象成更高层次
(define (flipped-pairs painter)
  (let ([painter2 (beside painter (flip-vert painter))])
    (below painter2 painter2)))

(define e4 (flipped-pairs einstein))

;; 同样也可以递归
(define (right-split painter n)
  (if (= n 0)
      painter
      (let ([smaller (right-split painter (- n 1))])
        (beside painter (below smaller smaller)))))
(paint (right-split einstein 4))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ([smaller (up-split painter (- n 1))])
        (below painter (beside smaller smaller)))))

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ([up (up-split painter (- n 1))]
            [right (right-split painter (- n 1))])
        (let ([tl (beside up up)]
              [br (below right right)]
              [corner (corner-split painter (- n 1))])
          (beside (below painter tl)
                  (below br painter))))))
(paint (corner-split einstein 1))

(define (square-limit painter n)
  (let ([quarter (corner-split painter n)])
    (let ([half (beside (flip-horiz quarter) quarter)])
      (below (flip-vert half) half))))
(paint (square-limit einstein 4))

高阶操作

和前面 higher-order-procedure 一样，可以接收 painter 为参数，可以返回 painter。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(define (square-of-four tl tr bl br)
  (lambda [painter]
    (let ([top (beside (tl painter) (tr painter))]
          [bottom (beside (bl painter) (br painter))])
      (below bottom top))))

(define (flipped-pairs-2 painter)
  (let ([combine4 (square-of-four identity flip-vert
                                  identity flip-vert)])
    (combine4 painter)))
(paint (flipped-pairs-2 einstein))

(define (square-limit-2 painter n)
  (let ([combine4 (square-of-four flip-horiz identity
                                  rotate180 flip-vert)])
    (combine4 (corner-split painter n))))
(paint (square-limit-2 einstein 4))