walker...to the next step

老潘已转到http://www.panxingzhi.net/。所有旧文章如有改动，此处将不再更新。谢谢。

I've moved to http://www.panxingzhi.net/. Updates on old posts are not applied here. Thanks.

啊啊，真是受不了，大家动作好快啊，北言趁着生日去领证儿了，海底鱼姐姐都有喜了。。。

我我我，我只能说，我没浪费生命。。。剩下的顺其自然吧，唉。

最近想看很多书，尤其是政治和历史的。与其说我对政治和历史感兴趣，不如说我对人类的生活感兴趣。可惜上学时那么多政治课历史课，竟令我一点劲头都没有。

向各位等SICP答案的看官说声抱歉，老潘实在分身乏术，但老潘虽然慢，却断不会放弃，会坚持把每一道题写完！

经老潘在朋友间小规模调研，得出结论：大家普遍最喜欢打棒球那场戏。

这究竟是为什么呢？我觉得大概是因为那场戏太健康了吧。一群体力无限跑不死，登高上树掏鸟窝的型男型女，他们在风雨交加的一天。。。打棒球。。。人总是对自己没有的东西充满了向往。从某种程度上来说，短短几十秒的镜头，满足了一点点我们内心深处继承自远古的对那种充满野性力量身体的渴望。

总觉得那个吸血鬼医生耍棒子的姿势很帅啊~

老潘总在独自运动时，比如在进行跑步或者跳绳这种乏味的小学低年级活动时，脑海中产生一些很深刻的见解。这充分证明了老潘其实是个想保持阳光运动形象的宅男，或者说老潘是个富于哲理勤于思考的明日体坛之星，whatever，你知道我在搞笑就行。

不过今天不知道为什么想到了“对事不对人”这句话。说起来我一直不太容易原谅自己做过的蠢事。与其说完美主义，倒不如说是两个原因：1、脸皮薄；2、放不下。尤其是用事后明白的眼光去看当时的行径，经常让我无地自容。但所谓人非圣贤，孰能无过；纵然牛逼，也得犯错。我十分想给自己找辙，宽恕自己，不再背着过去这些包袱，在本已健康的人生上更加彪悍一把。如果我能有一种超能力，“选择性遗忘”确实很有吸引力，大概能排在前三吧。

所以我想恬不知耻的跟自己说：你已经做得不错了，不要老想过去那些没用的事儿了。往前看。当你觉得惭愧时，看看那些比你更加傻逼的人，你就会欣然向前的。

说起来，这些日子集中精力在做一件事，实在腾不出时间来看计算机书了啊。但我一有空就会继续的。

本人偶然发现的两个Lingoes快捷键，感觉还是有些用处的。奇怪的是我在任何地方都没发现相关说明。也许是Lingoes所使用的GUI Framework提供的功能吧。。。

Ctrl+Enter

在主窗口中，当光标位于输入框时，这个组合键使Lingoes显示与当前输入字母组合匹配最好的字典条目。这使你不必输入完整的单词即可查询。举个例子，如果你输入zephy，Lingoes会显示zephyr但是如果你直接按Enter会一无所获。原因是没有完整匹配的条目可供显示。这时如想偷懒键入Ctrl+Enter即可。

在鼠标/剪贴板浮动查词窗口中，当光标位于输入框时，此组合键将所查条目移入主窗口查询。试试便知。

Ctrl+Z

这可真是个。。。划时代的大发现。。。太有用了。在主窗口中查词完成后，Ctrl+Z使光标回到输入框中并在输入框中显示并选中上一条输入。关键是使光标回到输入框中这个副作用很有用。。。对于我这个键盘狂人来说。。。

且慢，我还发现n多其他组合键也有这个副作用，但都伴随一声warning。比如Ctrl+M, Ctrl+Q等等。我怀疑是GUI Framework尝试将组合键的字符值放入输入框所导致的。

why functional programming matters里看来的例子，改成了Scheme版本。

占个位子。等SICP做到第四章，搞出LE，这个就可以解决了。

(define (within eps lst)
  (let ((a (car lst))
        (b (cadr lst)))
    (if (<= (abs (- a b)) eps)
        b
        (within eps (cdr lst)))))

(define (repeat f a)
  (cons a (repeat f (f a))))

(define (square-root guess eps n)
  (within esp (repeat
               (lambda (x) (/ (+ x (/ n x)) 2))
               guess)))

老潘的记录已经彻底跟不上了生活的变数了，于是干脆就不怎么写了。就像这次去美国，索性连相机都不带，一身轻松。反正生活的精彩都留在记忆里；处心积虑的想带走风景，无论如何也是不可能的。

这些其实是我生活态度发生变化的一些表现而已。比起过去我更加活在当下。

08年过去了。跟以往不同，我好像没有任何放不下。也许是这一年太充实了，我过得非常满意。

第一次在程序员杂志上发表文章：刚过去的08年12期。如果你看到有一个脖子上挂着白色森海PX200人傻笑，并且说他喜欢Python和Scheme，还是Vim的忠实用户，那就是在下了。

今年我有4个月呆在欧洲和美国，感受了不同的人和思想，也略微体会了一把不同的生活方式。最重要的是，在挣扎了几年之后，经历了许多的我，重新获得了坚定的理想，和敢于梦想的自由的心！

之后的十年，我都不为踌躇理想而发愁了。

(define (apply-generic op . args)
  (let* ((type-tags (map type-tag args))
         (proc (get op type-tags)))
    (if proc
      (apply proc (map contents args))
      ; if no operation found, we try to coerce the arguments to the type of
      ; each one of them, starting from the first
      (let* ((get-coercion-procs
               ; get-coercion-procs gives a list of coercion procedures
               ; targeting one specific type, if possible
               (lambda (target-type)
                 (map
                   (lambda (arg-type)
                     (if (eq? arg-type target-type)
                       ; if the types are the same, return the identity function
                       identity
                       ; if not, get the coercion function. can be null
                       (get-coercion arg-type target-type)))
                   type-tags))))
        (define (type-tags-iter type-tags)
          (if (not (empty? type-tags))
            (let (coercion-procs (get-coercion-procs (car type-tags)))
              (if (not (member? null coercion-procs))
                ; successful coercion
                (apply-generic op (map apply coercion-procs args))
                ; failed to coerce everything. next round
                (type-tags-iter (cdr type-tags))))
            ; if type-tags is empty, we have tried the type of the last argument
            (error "No method for these types"
                   (list op type-tags))))
        (type-tags-iter type-tags)))))

This method is not general enough when the arguments do have a common ancestor but the ancestor type does not show up in the arguments, thus we can miss it.

An example can be (triangle kite) in figure 2.26. They can both be coerced to polygon but we'll miss it.

; Current apply-generic is not bullet-proof: it first tries to get the correct
; operation based on op and type-tags. Only when it fails this step, it tries
; coercion. So the scenario Louis Reasoner described only happens when an
; operation is not registered/installed, thus cannot be found, for 2 numbers of
; the same type.
(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))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (let ((t1->t2 (get-coercion type1 type2))
                      (t2->t1 (get-coercion type2 type1)))
                  (cond (t1->t2
                         (apply-generic op (t1->t2 a1) a2))
                        (t2->t1
                         (apply-generic op a1 (t2->t1 a2)))
                        (else
                         (error "No method for these types"
                                (list op type-tags))))))
              (error "No method for these types"
                     (list op type-tags)))))))

; a. Such a call incurs an infinite recursion. Since the exp operation for 2
; complex numbers is not installed, apply-generic can't find anything in its
; first attempt. Then it tries to coerce the 2 arguments in both ways and
; succeeds immediately, thanks to Louis' installation. But then it's back to
; where it started.
; b. No he's wrong. If the operation of 2 same typed
; operands cannot be found, then let it be, give some errors. Don't try
; coercion since it doesn't change anything in this case.
; c.
(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))
        (if (= (length args) 2)
          (let ((type1 (car type-tags))
                (type2 (cadr type-tags)))
            (if (not (eq? type1 type2))
              (let ((a1 (car args))
                    (a2 (cadr args))
                    (t1->t2 (get-coercion type1 type2))
                    (t2->t1 (get-coercion type2 type1)))
                (cond (t1->t2
                        (apply-generic op (t1->t2 a1) a2))
                      (t2->t1
                        (apply-generic op a1 (t2->t1 a2)))
                      (else
                        (error "No method for these types"
                               (list op type-tags)))))
              (error "No method for these types"
                     (list op type-tags))))
          (error "No method for these types"
                 (list op type-tags)))))))

;; data-directed version

; generic zero? for all numbers
(define (zero? x) (apply-generic 'zero? x))

; inside scheme-number/rational/complex packages. note that we don't need to tag because the result is boolean
(put 'zero? '(scheme-number)
     (lambda (x) (= x 0)))
(put 'zero? '(rational)
     (lambda (x) (= (numer x) 0)))
; delegate to lower layer, or we should say, the sub packages
(put 'zero? '(complex) zero?)

; generic zero? for all complex
(define (zero?-complex x) (apply-generic 'zero? x))

; inside polar/rectangular packages. note that we don't need to tag because the result is boolean
(put 'zero? '(polar)
     (lambda (z) (= (magnitude z) 0)))
(put 'zero? '(rectangular)
     (lambda (z) (and (= (real-part z) 0) (= (imag-part z) 0))))

;; data-directed version
; generic
(define (equ? x y) (apply-generic 'equ? x y))
; inside packages. note that we don't need to tag because the result is boolean
(put 'equ? '(scheme-number scheme-number) =)
(put 'equ? '(rational rational)
     (lambda (x y) (and (= (numer x) (numer y))
                        (= (denom x) (denom y)))))
; we can use real/imag or magnitude/angle, just pick the first one
(put 'equ? '(complex complex)
     (lambda (z1 z2) (and (= (real-part z1) (real-part z2))
                          (= (imag-part z1) (imag-part z2)))))

(define (attach-tag type-tag contents)
  (if (number? contents)
    ; no tag if it's a number
    contents
    (cons type-tag contents)))
(define (type-tag datum)
  ; if it's a number, return the (unused) tag
  (cond ((number? datum) 'scheme-number)
        ((pair? datum) (car datum))
        (else (error "Bad tagged datum -- TYPE-TAG" datum))))
(define (contents datum)
  ; if it's a number, return itself
  (cond ((number? datum) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum -- CONTENTS" datum))))

; then the Scheme number package can remain unmodified

magnitude的定义很简单：

(define (magnitude z) (apply-generic 'magnitude z))

apply-generic的作用其实就是“剥掉”标签，根据标签和op参数查表取得“具体”操作，并执行之。

(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 method for these types -- APPLY-GENERIC"
            (list op type-tags))))))

注意我们有两个table，一个是scheme-number/rational/complex的，一个是polar/rectangular的。前者只定义了加减乘除四个操作。“具体”magnitude操作只在后表中定义了。

Alyssa的做法实际上是将magnitude操作注册在第一个表中：

(put 'magnitude '(complex) magnitude)
 
而这里的“具体”magnitude就是前面调用apply-generic的那个。书中前面出现了n多magnitude，但引入data-directed之后，只有这个是全局的。

所以当我们对一个贴着complex标签的数据如(complex (rectangular (3 4)))执行magnitude时，apply-generic首先剥掉complex标签并在第一个表中找到相应的magnitude。这个magnitude其实和刚执行完的是一样的。。。紧接着这个magnitude被执行，参数是刚被剥掉complex标签的数据即(rectangular (3 4))。这个数据是带着polar/rectangular标签的。接下来apply-genericy又被执行，剥掉polar/rectangular标签并找到相应的“真正的”具体操作，再执行。在我们的例子中，针对rectangular的magnitude会被执行在(3 4)上。

也就是说apply-generic被执行了两次。

有了这篇的基础，问题很好回答。

对于GOED，加入新的type需要改动所有的现存operation。加入新的operation则只需新增针对具体type的operation代码，和一个通用operation代码。

对于data-directed，无论是新增type还是operation，都只需在表中加入新内容即可，代码无需改动。

对于MP，加入新type只需新增此具体数据类型的过程表示，和其operation实现即可。加入新的operation则要改动所有现有的type。

所以如若系统中经常引入新type，可使用MP或data-directed。若经常引入新operation，可使用GOED或data-directed。

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