关于SICP中练习2.85与练习2.86

这是书中对于2.5节里通用算数系统最后的两个练习了。其中练习2.85还是非常简单的，因为思路在题目中已经完全给出了，我们要做的只是用scheme翻译一下就好了，但是这个project过程的实现我还是想要吐槽一下。首先，按照书中题目的意思，这个过程本应该是将类型塔中的类型做下压的过程，与raise可以说是互为逆过程（题目中的要求也是这样，希望通过类似: (equ? x (raise (project x))) 这样的谓词逻辑来判断对一个类型简化的正确性；但是我在练习2.79与练习2.80的文章里实现过一个更为通用性的equ?过程，使得上面的判断逻辑可以像这样写:(equ? x (project x)) ，从而不用为了保持raise与project的硬性互逆而犯愁。当然，这还要为之前实现的equ?过程打个小补丁，我之后也会讲。），但是我发现，要实现与raise过程硬性互逆非常困难，这是因为计算机表示数据的限制而决定的。
首先，在离散的数字计算机里想要表示一个带小数的数，一般是使用浮点数表示。比如一个实数: (sqrt 5)，我们都知道这是一个无理数，也就是它的小数部分是无限不循环的；但是如果你想把它用浮点数的形式表示的话，那么任何一台现有的计算机都无法做到精确地表示；因为它的小数部分是无限大的，并且没有规律可以寻找，所以用浮点数只能表示一个它的近似值，而这个近似值的小数位数是有限的，也就是说，如果用浮点数的表示方式去表示一个无理数 (sqrt 5)，那么结果其实只是它的一个有理数的近似值而已。那你可能会说，可以用其他方式去表示它，比如写成连分数的形式，它就有规律可循了，然后用算法的形式去表示它，当需要调用它的时候，通过生成器的模式可以返回得到任意的精度。这样确实没错，但是这样无法表示出通用的实数类型。比方说，要表示π，因为它是一个超越数，所以连分数的形式也无法将它表示了，必须用无穷级数的形式了，那么生成器的相应算法还是需要更改。（同样的道理，如果要表示e，又是一套算法。）要知道这样的数据在实数集中可是有无穷多个啊，根本没法全部都给一一精确地表示出来啊。因此，计算机里最通用的直接表示实数的统一通用方法还是用浮点数，说白了，计算机能直接进行表示的实数类型，除了整数以外就是有理数。
所以说，书上开始出现的需要一种实数型数据表示的时候我也是一脸懵逼的。于是，我就用了一种非常直接的办法，就如我之前文章之中所说的，只要虚部为0的数，给它打上real标签，我就认为它是实数了。(其实等于没表示)这样也就直接导致了一个问题，保持raise与project的硬性互逆会相当困难。（但是，好在我之前实现的equ?过程比较给力，所以完全犯不着需要这样做）
按照，书本上的要求，raise过程会依据传入的参数不同而做三种过程的分派，分别是：
scheme-number -> rational 的提升
rational -> real 的提升
real -> complex 的提升
（正如我之前文章中所做的那样）如果要求保持raise与project的硬性互逆，那么project过程就必须按照所传入的参数类型，被分派成以下三个对应的过程：
complex -> real 的下降
real -> rational 的下降
rational -> scheme-number 的下降
其中，complex -> real 与 rational -> scheme-number 的过程非常容易实现，但是我觉得 real -> rational 的过程就完全没有这个必要了，原因我在上面已经分析过了。所以，我最终把project过程分派成了如下的三个过程，而放弃了raise与project的硬性互逆：
complex -> real
real -> scheme-number
rational -> scheme-number
具体的代码如下：

; 安装一个通用投影过程
; 将数据对象向下投影到类型塔的下面一层
(define (install-project-package)
    ; complex -> real
    (put 'project '(complex)
        (lambda (z) (attach-tag 'real (real-part z))))
    
    ; rational -> scheme-number
    (put 'project '(rational)
        (lambda (r) (make-scheme-number (round (contents (div (numer r) (denom r)))))))
    
    ; real -> scheme-number
    (put 'project '(real)
        (lambda (x) (make-scheme-number (round x))))
    
    'done)

; 定义投影过程
(define (project x) (apply-generic 'project x))

这里需要注意，scheme-number不是指scheme中，所有能让谓词number?返回都为 #t 的数据，而只是其中的整数部分而已。我为了方便就没有做区分，而只是通过round过程来保证而已。
做完了这一步，正如上面所说的，需要为equ?过程打个小补丁：

; 将实数类型添加进练习2-79的 equ? 过程内
(define (install-real->complex-patch)
    (put 'transform '(real) (get 'transform '(scheme-number)))
    'done)

正如我之前实现练习2-79的代码中那样，transform过程不认识real类型，所以要为它再多加入一种分派方式。又因为我之前对real类型实现得非常简单粗暴，所以这种分派拿 scheme-number->complex 这个内部过程过来帮个忙就足够了；但是如果把它写成另外的一个补丁包的形式，则应该用get去写，因为 scheme-number->complex 是一个内部过程，无法直接被外部访问。
接下来是实现这道练习的核心方法drop，但是我比较笨，对于直接去实现它的逻辑不是怎么清楚，于是退而求其次，先实现了一个辅助的方法：

; 将一个数据下压一次
; 如果下压成功就返回下压的结果 否则返回 #f
; 其中的 equ? 过程由练习2-79中定义
(define (drop-one data)
    (let ((type (type-tag data)))
        (if (eq? type 'scheme-number)
            data
            (let ((p-data (project data)))
                (if (equ? p-data data)
                    p-data
                    #f)))))

有了这个辅助的方法，那么对于连续的下落过程drop的实现就非常容易了：

; 将一个数据尽可能地下落
(define (drop data)
    (let ((p-data (drop-one data)))
        (if p-data
            (let ((new-type (type-tag p-data))
                  (type (type-tag data)))
                (if (eq? new-type type)
                    p-data
                    (drop p-data)))
            data)))

因为，当下落到类型塔中的最底层的时候，为了防止出现无限递归的情况，所以要做一下类型的判断，以退出递归。这样，我们就完美地避开了要求保持raise与project的硬性互逆这样棘手的问题。
有了这个过程，对于接下来用它去改写练习2.84中的apply-generic过程就非常容易了。我直接上代码了：

; 用 drop 改写 apply-generic
; 使之可以“简化”其结果
(define (apply-generic op . args)
    
    (define (no-method-error tags)
        (error
            "No method for these types"
            (list op tags)))

    (let ((type-tags (map type-tag args)))
        (let ((proc (get op type-tags)))
            (if proc
                (let ((result (apply proc (map contents args))))
                    (if (or (eq? op 'add)
                            (eq? op 'sub)
                            (eq? op 'mul)
                            (eq? op 'div))
                        (drop result)
                        result))
                (let ((type-top
                            (apply max (map get-rank type-tags))))
                    (let ((new-args
                                (map (lambda (x) (raise-it x type-top)) args)))
                        (let ((new-type-tags (map type-tag new-args)))
                            (if (equal? new-type-tags type-tags)
                                (no-method-error type-tags)
                                (apply apply-generic (cons op new-args))))))))))

但是需要注意，这里有一个大陷阱。可能你会认为直接写成这个样子就可以了：
(drop (apply proc (map contents args)))
但是，并不是所有用apply-generic分派出来的结果都是可以被简化的，比如像raise与project过程我们同样使用apply-generic去做分派，但是如果对他们的结果也去做drop，那么直接就会导致结果的错误。所以，对于通用型计算来说，只需要对add，sub，mul，div这四个过程做drop就足够了。至此，全部完成练习2.85。
然后是练习2.86。这道练习其实也没什么难度，无非就是重构一下代码，将：
install-rectangular-package
install-polar-package
install-complex-package
这三个模块中的基础运算全部转化成相应的可以满足通用类型的运算罢了。但是，如果真按照书中所提示的思路去做，比如像sin和cos这种类型的运算都写成像add，sub，mul，div这样通用型过程的话，工作量也太大了，同时也没什么技术含量了，我也就犯不着在这里装逼了。
先分析一下题目的要求，它说将复数的表示中的实部、虚部、模、幅角都可以用类型塔中除了complex以外的数据类型来表示，那么，相当于上面三个包中的只要牵扯到对实部、虚部、模、幅角的运算的语句全部都得重写，改用重新定义的通用过程来替换原来的运算过程。我重新看了一下这三个包的代码，总共需要改写九种运算，他们分别是：square、sqrt 、+ 、-、 *、 /、 sin 、cos 、atan。我又意识到，其实这些运算本来都是定义在能让谓词number?返回都为 #t 的数据集合之上的，也就是说，他们在这个集合之上都是闭包的；那么，我们就可以通过当时做练习2.79与练习2.80的思路，通过统一他们的输入与输出的标准，在保持他们原有功能不变的同时，又让他们在我们的类型塔中也能实现闭包的话，那问题就解决了。但是类型塔中有四种类型，如果同时要在这四种类型上实现他们的闭包性质，那实在太困难了，所以可以这样实现：
首先，将所有的输入全部转换成scheme-number类型，然后让他们同时也返回scheme-number的类型，那就解决问题了。（其实，如果实现过练习2.78就会知道，scheme-number类型与scheme中自带的数的表示形式是完全等价的，所以我在这里采用了全部转成scheme-number的形式。）接下来是实现这种转换的代码：

; 把数据类型向scheme-number转换
(define (install-type->scheme-number-package)
    ; real -> scheme-number
    (put 'get-scheme-number '(real)
        (lambda (x) (make-scheme-number x)))
    
    ; rational -> scheme-number
    (put 'get-scheme-number '(rational)
        (lambda (r)
            (make-scheme-number
                (contents (div (numer r) (denom r))))))
    
    ; scheme-number -> scheme-number
    (put 'get-scheme-number '(scheme-number)
        (lambda (x) (make-scheme-number x)))
    
    'done)

; 转换接口
(define (get-scheme-number x)
    (apply-generic 'get-scheme-number x))

如上所述，通过get-scheme-number过程可以将类型塔中的real、rational、scheme-number类型都转换成统一的scheme-number类型。这样我们就可以通过这个过程，来统一对上面九个运算符的输入了。
但是，还有一个非常棘手的问题，就是需要重构上面三个包的代码。重构代码这种事情是我最不愿意干的，因为我确实比较懒。于是，我想能不能不重构之前的代码，也能实现题目中的要求呢？随之而来的是一个比较激进的想法，就是使用类似python中的装饰器的模式去欺骗mit-scheme解释器，使得上面所述的九种基础运算过程都可以同时实现在scheme-number类型与scheme内置的数的表示的这两个集合上的闭包。于是乎，我们需要一个通用的装饰器来增强这九种基础运算的功能，除了让他们保持原有的功能之外，还让他们可以在scheme-number类型上做运算。（虽然说这在本质上是同一回事）这样再通过get-scheme-number过程做统一的输入转换，就能满足题目的要求了。不得不说，装饰器确实是个好东西，它延长了码农的生命！

; 通用装饰器
; 将基础运算改写成可以处理组合数据的形式
; 并将结果以 scheme-number 的形式返回
(define (decorator f)
	; 转换参数
    (define (transform args)
        (map
            (lambda (arg)
                (if (number? arg)
                    (make-scheme-number arg)
                    (get-scheme-number arg)))
            args))
    ; 返回新过程
    (lambda (first . other)
        (let ((arg-seg (cons first other)))
            (if (apply and (map number? arg-seg))
                (apply f arg-seg)
                (make-scheme-number
                    (apply f (map contents (transform arg-seg))))))))

如上面代码所示，装饰器decorator总共有两部分组成，内部过程transform是一个参数转换的映射，它能将输入的各种类型的参数统一转换成scheme-number类型；然后是装饰器返回的一个增强后的匿名过程，它先判断参数列表中所有的参数是否是scheme中的数的表示形式，（这里 (apply and (map number? arg-seg)) 的写法与之前做练习2.82的文章中的 (accumulate and #t proc-seq) 写法类似，只是那个时候我一直以为and是个二元运算，而不是一个多元运算，所以用累加器去做的，想想当时的自己确实好蠢。）即能让number?返回 #t 的数据，如果是，就保持被装饰的过程 f 原来的所有功能不变，照常计算，否则，将所有的参数先统一转换成scheme-number类型做输入，等计算完成后再通过scheme-number类型的方式返回，实现在scheme-number类型上的闭包性质。但是，这个写法无法保证所有的过程都能保留原有的功能。比如 + 这个过程，mit-scheme解释器中对 (+) 的求值结果是 0，但是，如果按照上面的这个写法，则必须得至少传入一个参数才行，如果 + 过程被装饰了，那像 (+) 这样的表达式求值将不会像被装饰之前那样返回 0 了，而是会报错。（ * 过程也类似，(*) 求值返回 1 ）但是，恕我能力有限，确实想不到更好的写法了，所以先将就着用吧。
有了通用型的装饰器之后，还需要对上面的九个基础运算做装饰。为了日后处理方便起见，我先暂且将他们以列表的形式写在了一起：

(define op-list (list square sqrt + - * / sin cos atan))

然后是对他们统一进行装饰的过程：

; 重载运算符
(define (operator-overload! op-list)
    (map
        (lambda (f)
            (set! f (decorator f)))
        op-list))

这里使用了一个非常危险的过程set!，它可以改变一个变量的指针指向的对象，这在函数式编程中是大忌，通常地讲，只要改变了变量原先所绑定的值，那就不算是真正意义上的函数式编程了，所以，在scheme中对这种非常危险的过程，在过程名字后面都加上了一个！，作为传统，在调用他们的过程名字后面最好也加一个！，表示提醒程序员这类过程要慎用，即能不用就尽量不用。但是，没办法，如果不想改动源代码，那就必须用它。而这句话：(set! f (decorator f))的效果就类似于python中的装饰器语法糖：@decorator。还有一点必须要注意，这里的映射最好用map，而不要用for-each。因为set!过程在对变量的指针进行重定向之后，会把之前对对象的引用作为值给返回出来，一旦这里用for-each的话，那这些被set!返回的引用就会全部被释放掉了，然后这些对象会被解释器当垃圾给析构了，到那时如果你想再恢复这九个运算符原先的功能就完全不可能了。但是通过map返回出来就可以全部保留住他们。比如，之后你需要恢复这九个运算符原先的功能了，那就可以这样写：

; 回复过程原来的功能
(define (go-back regret)
	(for-each set! op-list regret))

; 保留住之前的过程
; 同时重载相应的运算符
(define regret (operator-overload! op-list))

; <做一些其它的事情>
; <做一些其它的事情>
; <做一些其它的事情>
; <做一些其它的事情>

; 回复之前的环境
(go-back regret)

而这里的go-back就无需做保留了，直接用for-each来做映射就可以了，同样，这里因为没有保留set!所返回的值，所以就没有在go-back后面加！。至此，全部完成练习2.86。

=============================================================
之前一直没有时间对代码进行调试，今天一跑之后发现了一些问题，在这里做更正。首先是一个关于apply的bug，看下图：

怎么样，很无奈吧，关键字竟然不能被表达式使用。不过好在问题不大，我们只要把原来代码中的if条件写得再low一点就能够解决了：

(define (decorator f)
    (define (transform args)
        (map
            (lambda (arg)
                (if (number? arg)
                    (make-scheme-number arg)
                    (get-scheme-number arg)))
            args))
    
    (lambda (first . other)
        (let ((arg-seg (cons first other)))
            (if (accumulate (lambda (x y) (and x y)) #t (map number? arg-seg))
                (apply f arg-seg)
                (make-scheme-number
                    (apply f (map contents (transform arg-seg))))))))

然后是另一个比较严重的问题，operator-overload!这个过程竟然没有效果！算了，我也不想再深究了，干脆手动装饰把：

(define square (decorator square))
(define sqrt (decorator sqrt))
(define + (decorator +))
(define - (decorator -))
(define * (decorator *))
(define / (decorator /))
(define sin (decorator sin))
(define cos (decorator cos))
(define atan (decorator atan))

这样，代码就能够跑起来了。