3fen's Notebook

Section 4.3.3

当初上数分课，傅里叶级数把我们搞的欲仙欲死，过后到了常微分方程，课上老韩笑着说到了轻松的部分了，就像他爬泰山时候那个“快活三里”。这小节这几个小题是为了巩固amb-eval基础的，4.3整节的最后出现，实在有点“快活三里”的感觉。

4.50
主要不同之处就是amb中的序列是从左到右依次抽取，用的是car cdr，而这里用的是random-choose。
(define (analyze-ramb exp)
  (let ((cprocs (map analyze (amb-choices exp))))
    (lambda (env succeed fail)
      (define (try-next choices)
        (if (null? choices)
            (fail)
            (let ((random-pick (random-choose choices)))
              (let ((the-right-one (car random-pick))
                    (rest-ones (cdr random-pick)))
                (the-right-one env
                               succeed
                               (lambda() (try-next rest-ones)))))))
        (try-next cprocs))))

random-choose参数为一个list，结果是一个序对，car为抽取的元素，cdr为其余的。       
(define (random-choose seq)
  (define (random-integer-between low high)
    (+ low (random (+ (- high low) 1))))
  (let ((ref (random-integer-between 1 (length seq))))
    (define (foo k items)
      (if (= k 1)
          items
          (let ((foo-next (foo (- k 1) (cdr items))))
            (cons (car foo-next)
                  (cons (car items) (cdr foo-next))))))
    (foo ref seq)))
   
应用ramb去实现ex 4.49中的语句生成：
把里面所有的amb全部改为ramb就可以了，这样执行(parse '())就可以生成句子，不过有时动不动就出现几万、几十万字的句子……

为了控制一下句子的长度，便增加了两个全局变量verb-layer和noun-layer，利用它们控制动词短语和名词短语的层数。
(define verb-layer 0)
(define noun-layer 0)
然后在parse-verb-phrase和parse-noun-phrase中控制：
(define (parse-verb-phrase)
  (define (maybe-extend verb-phrase)
    (require (< verb-layer 3))
    (ramb verb-phrase
          (begin (set! verb-layer (+ 1 verb-layer))
                 (maybe-extend (list 'verb-phrase
                                     verb-phrase
                                     (parse-prepositional-phrase))))))
  (maybe-extend (parse-word verbs)))
(define (parse-noun-phrase)
  (define (maybe-extend noun-phrase)
    (require (< noun-layer 3))
    (ramb noun-phrase
          (begin (set! noun-layer (+ 1 noun-layer))
                 (maybe-extend (list 'noun-phrase
                                     noun-phrase
                                     (parse-prepositional-phrase))))))
  (maybe-extend (parse-simple-noun-phrase)))

每次分析开始都要清0，以便重新构造。
(define (parse-sentence)
  (set! verb-layer 0)
  (set! noun-layer 0)
  (list 'sentence (parse-noun-phrase) (parse-verb-phrase)))

这样，运行(parse '())就可以生成不太长的句子了，而且不断的try-again可以遍历它们！可惜速度有些慢。


ps. 做这题的时候出了点小毛病：开始做的时候random-integer-between中的random部分我没+1，结果代价就是(random-integer-between 1 2)只会出现1.。这一小错不要紧，导致后面的an-element-of只是顺序取值。我当时还是没发现病因，就胡乱猜测ramb不能用an-element-of这种递归形式，而只能用(ramb 1 2 3 4 5)这种（当时竟然没发现这个式子从来第一次没出现过5）。然后又用宏实现了一个amb-eval中类似scheme中的apply过程，这样就可以把多个参数作为一个列表传过来……前后折腾了两个多小时，才走上正道。

4.51
比原来的set!要简单，就是去掉消除副作用的部分就行了。
(define (analyze-permanent-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env succeed fail)
      (vproc env
             (lambda (val fail2)
               (set-variable-value! var val env)
               (succeed 'ok
                        fail2))
             fail))))
             
4.52
只要看出aproc应该在cproc的fail部分被调用就明白了。
(define (analyze-if-fail exp)
  (let ((cproc (analyze (if-fail-consequent exp)))
        (aproc (analyze (if-fail-alternative exp))))
    (lambda (env succeed fail)
      (cproc env
             succeed
             (lambda ()
               (aproc env succeed fail))))))
(define (if-fail-consequent exp) (cadr exp))
(define (if-fail-alternative exp) (caddr exp))

4.53             
生成和为素数的序对，就和当初的map-filter一样。
((8 35) (3 110) (3 20))

4.54
(define (analyze-require exp)
  (let ((pproc (analyze (require-predicate exp))))
    (lambda (env succeed fail)
      (pproc env
             (lambda (pred-val fail2)
               (if (false? pred-val)
                   (fail2)
                   (succeed 'ok fail2)))
             fail))))

Section 4.3.2
4.38
此处中译版出错：原文"Modify the multiple-dwelling procedure to omit the requirement that Smith and
Fletcher do not live on adjacent floors."  翻译"增加斯迈尔和弗莱舍不住相邻层的要求。" 把omit翻译成了"增加"。
题目答案明显：去掉(require (not (= (abs (- fletcher smith)) 1)))这一句即可。
结果有5条：
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))
((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))
((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))

4.39
有关系。题目中一共会通过一系列require检测5^5种情况。改变require语句的顺序就可以调节每次检测的速度，也就是把限制性强、检测起来快的原则放在前面，其余放在后面。比如(require (distinct? (list baker cooper fletcher miller smith)))这条语句就应该放在后面。

通过实验验证：把current-inexact-milliseconds放入求解过程中，用来观测运行时间。
(define (multiple-dwelling)
  (let ((former-time (current-inexact-milliseconds))
        (baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (require (distinct? (list baker cooper fletcher miller smith)))
    (display (- (current-inexact-milliseconds) former-time))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))
结果：
;;;Starting a new problem 360.0
;;;Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
而原过程所需时间为500左右，猜测正确。

4.40         
(define (multiple-dwelling)
  (let ((former-time (current-inexact-milliseconds))
        (baker (amb 1 2 3 4 5)))
    (require (not (= baker 5)))
    (let ((cooper (amb 1 2 3 4 5)))
      (require (not (= cooper 1)))
      (let ((fletcher (amb 1 2 3 4 5)))
        (require (not (= fletcher 5)))
        (require (not (= fletcher 1)))
        (require (not (= (abs (- fletcher cooper)) 1)))
        (let ((miller (amb 1 2 3 4 5)))
          (require (> miller cooper))
          (let ((smith (amb 1 2 3 4 5)))
            (require (not (= (abs (- smith fletcher)) 1)))
            (require (distinct? (list baker cooper fletcher miller smith)))
            (display (- (current-inexact-milliseconds) former-time))
            (list (list 'baker baker)
                  (list 'cooper cooper)
                  (list 'fletcher fletcher)
                  (list 'miller miller)
                  (list 'smith smith))))))))
这就和我们做题的思路比较像了——用判断条件直接排除掉一系列情况，而不是把所有情况列举出来一个个筛选。
效果也是很明显，47.0，比上一题中的360.0快了不少。

4.41
用的是第二章的那种map--filter方法：
(define (situ n)
  (if (= n 1)
      (map list '(1 2 3 4 5))
      (flat-map (lambda (x)
                  (map (lambda(xx) (cons x xx)) (situ (- n 1))))
                '(1 2 3 4 5))))
(filter (lambda (x)
          (let ((baker (car x))
                (cooper (cadr x))
                (fletcher (caddr x))
                (miller (cadddr x))
                (smith (car (cddddr x))))
            (and (not (= baker 5))
                 (not (= cooper 1))
                 (not (= fletcher 1))
                 (not (= fletcher 5))
                 (> miller cooper)
                 (not (= (abs (- smith fletcher)) 1))
                 (not (= (abs (- fletcher cooper)) 1))
                 (distinct? x))))
        (situ 5))
结果：((3 2 4 5 1))

4.42
所谓一句真话一句假话，可以看做是两个条件异或求值为真。由于这道题存在异或关系的判断，所以还需要给求值器加入and or这两个special-form。
;;======and  or=======
(define (analyze-and exp)
  (define (helper clauses)
    (if (null? clauses)
        (lambda(env succeed fail)
          (succeed true fail))
        (lambda (env succeed fail)
          ((analyze (car clauses)) env
                                   (lambda (val fail2)
                                     (if (false? val)
                                         (succeed false fail2)
                                         ((helper (cdr clauses)) env succeed fail2)))
                                   fail))))
  (helper (cdr exp)))
(define (analyze-or exp)
  (define (helper clauses)
    (if (null? clauses)
        (lambda(env succeed fail)
          (succeed false fail))
        (lambda (env succeed fail)
          ((analyze (car clauses)) env
                                   (lambda (val fail2)
                                     (if (true? val)
                                         (succeed true fail2)
                                         ((helper (cdr clauses)) env succeed fail2)))
                                   fail))))
  (helper (cdr exp)))

这样就可以定义异或关系，通过和例子中相同的方法解答：
(define (xor p1 p2)
  (or (and p1 (not p2))
      (and (not p1) p2)))
(define (liars)
  (let ((betty (amb 1 2 3 4 5))
        (ethel (amb 1 2 3 4 5))
        (joan (amb 1 2 3 4 5))
        (kitty (amb 1 2 3 4 5))
        (mary (amb 1 2 3 4 5)))
    (require (xor (= kitty 2) (= betty 3)))
    (require (xor (= ethel 1) (= joan 2)))
    (require (xor (= joan 3) (= ethel 5)))
    (require (xor (= kitty 2) (= mary 4)))
    (require (xor (= mary 4) (= betty 1)))
    (require (distinct? (list betty ethel joan kitty mary)))
    (list (list 'betty betty)
          (list 'ethel ethel)
          (list 'joan joan)
          (list 'kitty kitty)
          (list 'mary mary))))
最后得到唯一解：((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4))

4.43
这题比较复杂。那个multiple-dwelling问题只有一组关系：人和楼层。这里有两组关系：女儿与父亲，女儿名字与游艇所有者。这里我取的是女儿&游艇名字作为amb的对象，我感觉用父亲的名字也可以(父亲的女儿&父亲的游艇)。所以本题中某人，比如Ann，其值是一个list，(car Ann)为Ann的父亲，(cadr Ann)为游艇Ann的主人。为了方便，自己用数字给这5个父亲打标((Moore Downing Hall SB.Hood Parker) is (1 2 3 4 5))。
程序如下（好长）：
(define (girls-and-yachts)
  (define (father-of girl)  (car girl))
  (define (owner-of-the-yacht girl-name) (cadr girl-name))
  (let ((Ann (list (amb 1 2 3 4 5) (amb 1 2 3 4 5))))
    (require (distinct? (list (father-of Ann) (owner-of-the-yacht Ann))))
    (require (= (father-of Ann) 1))
    (let ((Gabrielle (list (amb 1 2 3 4 5) (amb 1 2 3 4 5))))
      (require (distinct? (list (father-of Gabrielle) (owner-of-the-yacht Gabrielle))))
      (require (= (owner-of-the-yacht Gabrielle) 4))
      (let ((Lorna (list (amb 1 2 3 4 5) (amb 1 2 3 4 5))))
        (require (distinct? (list (father-of Lorna) (owner-of-the-yacht Lorna))))
        (require (= (owner-of-the-yacht Lorna) 1))
        (let ((Rosalind (list (amb 1 2 3 4 5) (amb 1 2 3 4 5))))
          (require (distinct? (list (father-of Rosalind) (owner-of-the-yacht Rosalind))))
          (require (= (owner-of-the-yacht Rosalind) 3))
          (let ((Melissa (list (amb 1 2 3 4 5) (amb 1 2 3 4 5))))
            (require (distinct? (list (father-of Melissa) (owner-of-the-yacht Melissa))))
            (require (= (owner-of-the-yacht Melissa) 2))
            (require (= (father-of Melissa) 4))
            (let ((girls (list Ann Gabrielle Lorna Rosalind Melissa)))
              (define (whose-father-is x girl-list)
                (cond ((null? girl-list) (list 0 0))
                      ((= (father-of (car girl-list)) x) (car girl-list))
                      (else (whose-father-is x (cdr girl-list)))))
              (require (= (father-of Gabrielle) (owner-of-the-yacht (whose-father-is 5 girls))))
              (let ((the-fathers (map father-of girls))
                    (the-owners (map owner-of-the-yacht girls)))
                (require (distinct? the-fathers))
                (require (distinct? the-owners))
                (list (list 'Ann Ann)
                      (list 'Gabrielle Gabrielle)
                      (list 'Lorna Lorna)
                      (list 'Rosalind Rosalind)
                      (list 'Melissa Melissa))))))))))
稍微绕了个弯的地方是最后一个条件"Gabrielle的父亲的游艇取的是Dr.Parker女儿的名字"，需要寻找"Dr.Parker的女儿"。

结果为((Ann (1 5)) (Gabrielle (3 4)) (Lorna (2 1)) (Rosalind (5 3)) (Melissa (4 2)))，也就是说Lorna的父亲是Colonel Downing。

如果去掉Ann姓Moore这个条件，也就是去掉(require (= (father-of Ann) 1))，会有两个结果：
((Ann (1 5)) (Gabrielle (3 4)) (Lorna (2 1)) (Rosalind (5 3)) (Melissa (4 2)))
((Ann (3 5)) (Gabrielle (1 4)) (Lorna (5 1)) (Rosalind (2 3)) (Melissa (4 2)))

4.44
记得视频中提到流的概念的时候举过八皇后的例子，说有两种策略，一是像构造一颗树那样一个一个的添加皇后，遇到错误后回溯；另一个就是把所有的可能都列举出来，然后筛选。当时采用的是流的方法，构造简单而且由于memo-proc的存在，使得速度上也不错。这次八皇后的解法使用了amb-eval的回溯机制，整个过程看起来更简单了。这个amb-eval写得实在是很巧妙……我只到了理解"鱼"的层次，离怎样想出amb-eval实现的方法这个"渔"的境界还很远。
(define (queens board-size)
  (define (safe? q position)
    (if (null? position)
        true
        (let ((old-queen (car position)))
          (and (not (= old-queen q))
               (not (= (abs (- old-queen q)) (length position)))
               (safe? q (cdr position))))))
  (define (adjoin-new-queen new-queen position)
    (append position (list new-queen)))
  (define (queen-cols q-ref)
    (if (= q-ref 0)
        '()
        (let ((old-position (queen-cols (- q-ref 1))))
          (let ((n-q (an-integer-between 1 board-size)))
            (require (safe? n-q old-position))
            (adjoin-new-queen n-q old-position)))))
  (queen-cols board-size))
 
 这里同样有当初ex 2.43中的那个关于效率的微妙问题：
 如果把queen-cols写成这样：
 (define (queen-cols q-ref)
    (if (= q-ref 0)
        '()
        (let ((n-q (an-integer-between 1 board-size)))
          (let ((old-position (queen-cols (- q-ref 1))))
            (require (safe? n-q old-position))
            (adjoin-new-queen n-q old-position)))))
那么就得到了当初Louis Reasoner的奇慢的程序。原因也差不多: 起回溯作用的语句是an-integer-between，而回溯的时候是没必要每次都再求一遍old-position的。


4.45
这题轻松一下，玩玩小时候拼词组句的小游戏。
5个结果，搭配本人中文自然语言译本：
;;教授教学生，教授在教室里，教授带着猫
(sentence (simple-noun-phrase (article the) (noun professor))
          (verb-phrase
           (verb-phrase
            (verb-phrase (verb lectures)
                         (prep-phrase (prep to)
                                      (simple-noun-phrase (article the) (noun student))))
            (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class))))
           (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
;;教授教学生，教授在教室里，教室带着猫
(sentence (simple-noun-phrase (article the) (noun professor))
          (verb-phrase
           (verb-phrase (verb lectures)
                        (prep-phrase (prep to)
                                     (simple-noun-phrase (article the) (noun student))))
           (prep-phrase (prep in)
                        (noun-phrase
                         (simple-noun-phrase (article the) (noun class))
                         (prep-phrase (prep with)
                                      (simple-noun-phrase (article the) (noun cat)))))))
;;教授教学生，学生在教室里，教授带着猫
(sentence (simple-noun-phrase (article the) (noun professor))
          (verb-phrase
           (verb-phrase
            (verb lectures)
            (prep-phrase
             (prep to)
             (noun-phrase (simple-noun-phrase (article the) (noun student))
                          (prep-phrase (prep in)
                                       (simple-noun-phrase (article the) (noun class))))))
           (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
;;教授教学生，学生在教室里，学生带着猫
(sentence (simple-noun-phrase (article the) (noun professor))
          (verb-phrase
           (verb lectures)
           (prep-phrase
            (prep to)
            (noun-phrase
             (noun-phrase (simple-noun-phrase (article the) (noun student))
                          (prep-phrase (prep in)
                                       (simple-noun-phrase (article the) (noun class))))
             (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))
;;教授教学生，学生在教室里，教室带着猫
(sentence (simple-noun-phrase (article the) (noun professor))
          (verb-phrase
           (verb lectures)
           (prep-phrase
            (prep to)
            (noun-phrase
             (simple-noun-phrase (article the) (noun student))
             (prep-phrase
              (prep in)
              (noun-phrase (simple-noun-phrase (article the) (noun class))
                           (prep-phrase (prep with)
                                        (simple-noun-phrase (article the) (noun cat)))))))))

4.46
举例比如：
(define (parse-simple-noun-phrase)
  (list 'simple-noun-phrase
        (parse-word articles)
        (parse-word nouns)))
如果amb求值顺序为从右至左，那么对于'(a cat)就会先去用名词匹配a，造成混乱。

4.47
想法是正确的，有时也能得出正确结果，但有时也会出现问题：
比如(parse '(the cat eats in the class))，第一次结果正确，但是当try-again时发生死循环。
如果(parse '(the cat haha))，问题就更突出些：新的parse-noun-phrase是个死胡同，一旦进去就再不会出来，即使发生明显的不匹配也不会出来。

观察parse-word过程:
(define (parse-word word-list)
  (require (not (null? *unparsed*)))
  (require (memq (car *unparsed*) (cdr word-list)))
  (let ((found-word (car *unparsed*)))
    (set! *unparsed* (cdr *unparsed*))
    (list (car word-list) found-word)))

起判断匹配与否的语句是(require (memq (car *unparsed*) (cdr word-list)))，这样比如一个需要名词的地方出现了nouns里面没有的"haha"，那么就会运行(amb)。

看一下本来的parse-verb-phrase：
(define (parse-verb-phrase)
  (define (maybe-extend verb-phrase)
    (amb verb-phrase
         (maybe-extend (list 'verb-phrase
                             verb-phrase
                             (parse-prepositional-phrase)))))
  (maybe-extend (parse-word verbs)))
这里有否介词短语两种情况会调用parse-word来判断匹配情况，因为无论哪种情况首个单词都应该是动词，遇到"haha"都应该报错。

再看下Louis Reasoner同学的：
(define (parse-verb-phrase)
  (amb (parse-word verbs)
       (list 'verb-phrase
             (parse-verb-phrase)
             (parse-prepositional-phrase))))
看到了吧，这里parse-word是"可选的"，所以遇到了"haha"就绕开，而后递归调用(parse-verb-phrase)再绕……程序就死掉了。


4.48
偷懒写个最简单的形容词部分：
(define adjectives '(adj blue angry nice))
(define (parse-simple-noun-phrase)
  (amb (list 'simple-noun-phrase
             (parse-word articles)
             (parse-word adjectives)
             (parse-word nouns))
       (list 'simple-noun-phrase
             (parse-word articles)
             (parse-word nouns))))
测试：
;;;Amb-Eval input:
(parse '(the angry cat eats in the blue class))

;;;Starting a new problem
;;;Amb-Eval value:
(sentence (simple-noun-phrase (article the) (adjs angry) (noun cat))
          (verb-phrase (verb eats)
                       (prep-phrase (prep in)
                                    (simple-noun-phrase (article the)
                                                        (adjs blue)
                                                        (noun class)))))
                                                       
4.49
简单的修改：
(define (parse-word word-list)
  (let ((new-word (an-element-of (cdr word-list))))
    (list (car word-list) new-word)))
结果：      
the blue student studies
the blue student studies for the blue student
the blue student studies for the blue student for the blue student
...看来没有random-amb这东西真是不好玩                                                       

Section 4.3.1

由于前两小节的习题需要amb-evaluator去测试，所以需要先把4.3.3中的求值器实现。

amb-eval相比之前两个求值器要复杂，郁闷的看了n遍。其中比较麻烦的事情就是succeed和fail过程传来传去，还有succeed的调用也让人一上来觉得不太适应。

所谓的succeed和fail，可以理解为运行过程中的两个分叉，之前接触的eval-apply循环、lazy-eval可以看做是全程succeed的情况。相类似的analyze-self-evaluating/analyze-quoted等过程，都只是传递succeed和fail过程而涉及不到运行的分叉。

处理if语句时，由于if-predict中可能有amb语句(可以造成fail)，所以要进行判断：如果if-predict是"成功的"，那么分情况考虑if-consequent或者if-alternative；若是"失败"的，就调用fail过程。书中analyze-if中的fail2只是为了在名字上与fail区分开来，实际的值也是fail，而不会存在两个不同的fail过程。

set!过程又与上面不同，由于需要消除赋值带来的副作用，所以求值assignment-value的fail过程和外层set!的fail过程是不同的，不可以像if那样直接调用过来。

个人感觉最难理解的是过程应用中的get-args过程。它的作用大概就是把apply的参数值提取出来(由于这些值都是(lambda(env succeed fail)(...)之类的东西，所以需要另写get-args而不是直接用map))。其中递归调用get-args时，增量是get-args的参数succeed的val部分。可以这么看: succeed过程实际是(lambda(args fail) (succeed args fail))，仔细观察程序可以发现，递归调用中的succeed部分是这样的：(lambda(args fail) (succeed (cons arg args) fail))，增加的那个arg就是提取出来的value。

相关的analyze-application和execute-application相对容易，理解这部分可以通过人肉追踪一个简单的过程应用来完成。比如(+ 1 (amb 2 3))。 (ps. 这里如果用Drscheme的调试功能会比较郁闷，因为绝大多数想知道的数据和过程都是(#procedure)...)
接下来的amb过程是整个求值器中最独特最独特的部分，但是原理并不复杂，有点类似analyze-sequence。

4.35
(define (an-integer-between low high)
  (if (> low high)
      (amb)
      (amb low (an-integer-between (+ 1 low)
                                   high))))

4.36
按照题中的顺序，如果只用an-integer-starting-from简单代替的话，程序会取i=1, j=1，然后把k从1一直取值试下去。得不到正确结果。
所以这里需要的是一种能够遍历i、j、k的方法，有点类似第三章讲流时的那个求所有整数序对的意思，不过这里更简单一些。
(define (a-pythagorean-triple)
  (let ((k (an-integer-start-from 1)))
    (let ((i (an-integer-between 1 k)))
      (let ((j (an-integer-between i k)))
        (require (= (+ (* i i) (* j j)) (* k k)))
        (list i j k)))))

4.37
没做实验，想来应该是快些的，避免了很多无效的列举。虽然增加了求平方根操作，不过相比较那些无效的ijk的运算也应该算是值得了。

1. 书上提到Y combinator是在Ex 4.21中，用来实现一些不用函数名称的递归方法。
这里！有一个构造Y的过程，最后可以以一个单个参数的过程为参数(比如阶乘，fibnacci不行)，得到一个不用函数名来实现递归的过程。
其中分了6个step，个人感觉Step2--6都是中规中距的做一些文字游戏，而Step1做的工作是创造性的(也就是书中4.21给出的例子)。
Step1 中构造了一个fact-maker：
  (define fact-maker
    (lambda (procedure)
      (lambda (n)
         (if (zero? n)
             1
             (* n ((procedure procedure) (- n 1)))))))
然后通过(fact-maker fact-maker)来成功构造fact过程。

而后面的工作就是抽象、组合，最后形成一个有一般意义的Y combinator，不过只能形成单个参数的过程。
(define Y
  (lambda(X)
    ((lambda(proc)
       (X (lambda(arg) ((proc proc) arg))))
     (lambda(proc)
       (X (lambda(arg) ((proc proc) arg)))))))



2. 视频Lecture-7a中也提到Y combinator，是在讲到求不动点的策略的时候，仿佛这个Y除了完成一些上述的小技巧之外，还有些更深层次的东西。
这里的不动点，不是狭义的指一个数值，它还包括函数过程。比如factorial过程就是
(lambda (proc)
  (lambda (n)
    (if (zero? n)
        1
        (* n (proc (- n 1))))))
的fixed-point。而这里求fixed-point的方法就是无限的迭代执行，就像拿起计算器随便取一个值然后狂按cos，最后得到0.73左右的一个数。这种方法可能得到正确结果，也可能得不到，结果取决与具体问题，就像线性方程组的解的情况（唯一/无限多个/无解）。而其原理的证明据说很复杂。
所以我们需要构造一个过程，使其能表达出无限的迭代。
(define Y
  (lambda(f)
    ((lambda(x) (f (x x)))
     (lambda(x) (f (x x))))))
这样定义Y就可以得到(Y F)=(F (Y F))的效果，从而产生(F (F (F...)))这一无限序列。
这里的Y比前面定义的要简洁一些，但是我不知道这样的Y在scheme中怎样与一个具体过程结合形成一个可以正常运行的过程。


实际工程实现中貌似是不会用Y来实现递归的，因为程序需要调试，需要交互。不过好像在lambda演算中意义不小。

Section 4.2.1
4.25
用非特殊形式的unless计算factorial会出现死循环，这是由于(factorial n)会不断的计算(factorial (- n 1))、(factorial (- (- n 1) 1))...而在此之前不会考虑过程体里面的if过程。
在正则序语言中可以。其实所谓正则序语言，并不是全部过程都不优先对参数求值(那样就永远得不到结果了...)，也是要有一些严格的基本过程做基础如if/cond等。这样在调用unless时对condition/usual-value/exception-value都会延迟求值，直到(= n 1)的判断时才会对n求值进而做判断是要执行usual-value还是exception-value。这样(factorial n)就能正常工作了。

4.26
实现：
(define (eval-unless exp env)
  (eval (make-if (unless-pred exp) (unless-exception exp) (unless-usual exp)) env))
(define (unless-pred exp) (cadr exp))
(define (unless-exception exp) (cadddr exp))
(define (unless-usual exp) (caddr exp))
然后加入安装包(put 'eval 'unless eval-unless)

但是如此生成为特殊形式，在环境中是不会有unless这个变量的。
比如定义这个过程，定义一个unless过程就是必要的：
(define (if-or-unless operator pred consequent alternative)
  (operator pred consequent alternative))
这里operator可以取if或者unless(可能把if生成表达式也是件麻烦事)。

Section 4.2.2
4.27
;;; L-Eval input:
count

;;; L-Eval output:
1

;;; L-Eval input:
w

;;; L-Eval output:
10

;;; L-Eval input:
count

;;; L-Eval output:
2
与应用序不同之处在(define w (id (id 10)))之后，count变为1而不是2. 原因是只有外层的id被执行了，而内层的id被延迟到求w时才得到执行。如果用带有记忆功能的force-it，以后再求值w时count不会变，否则每次count加1.

4.28
两者的不同之处就在于操作符的求值，所以找个操作符需要求值的例子：
(define (foo x) x)
((foo +) 10 20)
如果按照题中的做法，用eval而不是actual-value求(foo +)的值，会得到一个以'thunk开始的list，而不是(primitive +)，结果就是使apply报错。

4.29
主要不同体现在执行完(square (id 10))后count的值上。
有记忆功能的force-it会显示1，否则是2.

开始对这个save功能有些误解，以为可以实现类似ex 3.27中memorize的功能，使得诸如(fib 10)的求值过程在不同的调用中只执行一次。后来发现错了，这里的记忆功能只限于某个过程之内，只有当其参数被求值不止一次时，速度优势才会显现出来。
比如factorial：
(define (fact n)
  (if (= n 1)
      1
      (* n (- n 1))))
这里之所以能提高效率，是因为过程中对n的调用有3次。这样没有记忆功能的force-it就会对('thunk n)进行三次eval的求值，而有记忆功能的force-it只执行一次，之后两次就是简单的取thunk-value即可。

4.30
a) 争议部分在于(proc (car items))这一句，如果它得不到执行，那么就是Ben理解的Cy的意思；反之则是Ben反驳Cy的观点。跟踪一下for-each的执行过程可以发现，在这句执行时，其环境中proc的值应该是('thunk (lambda(x) (newline) (display x)) <env>)。通过eval对application部分的实现可知，这里proc作为操作符是要经过actual-value后才传给apply，所以此句可以执行并且得到执行。

b) 用原来的eval-sequence，(p1 1)和(p2 1)分别返回(1 2)和1。 (p1 1)返回(1 2)的原因与for-each类似，而(p2 1)中赋值语句没有得到执行的原因是(set! x (cons x '(2)))被放在了参数的位置上，而不是像proc那样放在操作数的位置上——参数是会被延迟求值的，又因为eval-sequence中对每个过程使用eval而不是actual-value求值，这里(eval e env)的结果是('thunk (set! x (cons x '(2))) <env>)。
如果应用的Cy的建议，那么两者都会返回(1 2)。对于(p2 1)，与原来不同的是eval-sequence对每个过程用了actual-value。那么执行到e时，实际的求值语句是(force-it (eval e env))，也就是对('thunk (set! x (cons x '(2))) <env>)进行了force-it操作。

c) 因为force-it语句中对参数是否为thunk有判断，对于没有thunk标签的过程也可以得到正确执行。

d) 个人感觉Cy的更好一些。首先Cy的过程没有违反惰性求值的要求——对象只有在需要时才求值，而且改正了原过程在某些情况下会犯的错误。比如(p2 1)，其中e在被需要时得到求值，但是我们并不希望某个变量求值以后得到的结果会是带有thunk头的这种内部形式，这样来看，原过程实际上可以认为是有错误的。

4.31
正则序和应用序在本章实现的解释器上主要区别就在与apply中一般过程(compound-procedure)中参数部分的处理：是list-of-true-value还是list-of-delayed-value。本题把这种不同变得更加一般化，那就是使一列参数中的不同个体可以用不同策略，而不是全部actual-value或者delay。
所以，我们只要控制不同的参数加入环境中的值即可，再由force-it根据环境中的值来决定采取何种策略来返回。
我通过(helper hvars hvals env)过程读入形参和实参，经过判断、求值返回一个序对，car和cdr就是可以直接加入环境的值。
;-----apply-helper-------
(define (helper hvars hvals env)
  (if (= (length hvars) (length hvals))
      (let ((new-vars (map (lambda (var)
                             (cond ((lazy-memo? var) (car var))
                                   ((lazy? var) (car var))
                                   ((not (pair? var)) var)
                                   (else (error "Wrong parameter " var))))
                           hvars))
            (new-vals (map (lambda(var val)
                             (cond ((lazy-memo? var) (delay-it-memo val env))
                                   ((lazy? var) (delay-it val env))
                                   (else (actual-value val env))))
                           hvars
                           hvals)))
        (cons new-vars new-vals))
      (if (< (length hvars) (length hvals))
          (error "Too Many vals" hvars hvals)
          (error "Too Few vals" hvars hvals))))
(define (lazy-memo? var)
  (and (pair? var) (eq? (cadr var) 'lazy-memo)))
(define (lazy? var)
  (and (pair? var) (eq? (cadr var) 'lazy)))         
这样可以把apply修改为:         
(define (apply procedure args env)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure procedure
                                    (list-of-true-value args env)))
        ((compound-procedure? procedure)
         (let ((env-result (helper (procedure-parameters procedure) args env)))
             (eval-sequence
              (procedure-body procedure)
              (extend-environment
               (car env-result)
               (cdr env-result)
               (procedure-environment procedure)))))
        (else (error "Unknown procedure type--APPLY" procedure))))
稍微修改一下force-it:
(define (force-it obj)
  (cond ((thunk? obj) (actual-value (thunk-exp obj) (thunk-env obj)))
        ((thunk-memo? obj)
         (let ((result (actual-value (thunk-exp obj) (thunk-env obj))))
           (set-car! obj 'evaluated-thunk)
           (set-car! (cdr obj) result)
           (set-cdr! (cdr obj) '())
           result))
        ((evaluated-thunk? obj) (thunk-value obj))
        (else obj)))

(define (thunk-memo? obj) (tagged-list? obj 'thunk-memo))
(define (delay-it-memo exp env) (list 'thunk-memo exp env))

测试用例：
1. (try 0 (/ 1 0))对于下面定义的执行情况：
 (define (try a b)
    (if (= a 0) 1 b))

 (define (try a (b lazy))
    (if (= a 0) 1 b))

2. 比较执行(factorial 1000)速度
(define (factorial n)
  (if (= n 1) 1 (* n (factorial (- n 1)))))
(define (factorial (n lazy))
  (if (= n 1) 1 (* n (factorial (- n 1)))))
(define (factorial (n lazy-memo))
  (if (= n 1) 1 (* n (factorial (- n 1)))))

ps: 开始看到参数中(b lazy)，lazy没有加上引号觉得奇怪，后来明白参数是直接传过去不经过求值的，也就不可以加上引用符号。


Section 4.2.3
可以用类似下面的方式来安装这些过程：
(define (install-compound-procs)
  (actual-value '(begin (define (cons x y)
                          (lambda(m) (m x y)))
                        (define (car x)
                          (x (lambda(p q) p)))
                        (define (cdr x)
                          (x (lambda(p q) q))))
                the-global-environment)
  ‘done)

4.32
巧了，第三章讨论过所谓的odd/even stream，也就和这里提到的"更加惰性"的表一样。
 
4.33
用的是类似于之前cond->if的派生表达式的做法，把'(1 2 3)改写为嵌套的cons，然后在环境中求值。
(define (text-of-quotation exp env)
  (define (helper x)
    (if (not (pair? x))
        x
        (list 'cons
              (car x)
              (helper (cdr x)))))
  (if (not (pair? (cadr exp)))
      (cadr exp)
      (actual-value (helper (cadr exp)) env)))
(put 'eval 'quote (lambda(exp env) (text-of-quotation exp env)))

4.34
比预想的要麻烦...
对于序对的表示，我只把car打印出来，这样有穷或是无穷的序对对此来说也没什么不同了。Drscheme本身的解释器功能比较强大，能打印出有环的序列。
大体思路是这样的：首先让解释器能识别出cons生成的过程与一般的过程的区别，然后在user-print中对其用car进行调用，得出结果打印。

为了让解释器分清cons与一般过程的不同，我新定义了一种语法形式special-lambda，相应的make-special-proc
(define (make-special-procedure name parameters body env) 
  (list (cons 'special-procedure name) parameters body env))
可以看到，这里多出一个name参数，使得它有一定的扩展性，而不只是检测cons这一个特殊过程。这样定义，也可以沿用原来的procedure-parameters和procedure-body过程。
相关的选择过程：
(define (special-procedure? proc)
  (if (pair? proc)
      (if (pair? (car proc))
          (eq? (caar proc) 'special-procedure)
          false)
      false))
(define (name-of-special-proc s-proc)
  (cdr (car s-proc)))
加入求值器：
(put 'eval 'special-lambda
       (lambda(exp env)
         (make-special-procedure (special-lambda-name exp)
                                 (special-lambda-parameters exp)
                                 (special-lambda-body exp)
                                 env)))
(define (special-lambda-name exp) (cadr exp))
(define (special-lambda-parameters exp) (caddr exp))
(define (special-lambda-body exp) (cdddr exp))

这样就可以这样定义cons:
(define (cons x y)
  (special-lambda cons (m) (m x y)))

 
apply过程需要修改，以便于识别special-procedure：
(define (apply procedure args env)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure procedure
                                    (list-of-true-value args env)))
        ((special-procedure? procedure)
         (eval-sequence
          (procedure-body procedure)
          (extend-environment
           (procedure-parameters procedure)
           (list-of-delayed-args args env)
           (procedure-environment procedure))))
        ((compound-procedure? procedure)
         (eval-sequence
          (procedure-body procedure)
          (extend-environment
           (procedure-parameters procedure)
           (list-of-delayed-args args env)
           (procedure-environment procedure))))
        (else (error "Unknown procedure type--APPLY" procedure))))

现在定义的cons已经可以运行，下面是打印过程的修改（只修改user-print即可）：
(define (user-print object)
  (if (compound-procedure? object)
      (display (list 'compound-procedure
                     (procedure-parameters object)
                     (procedure-body object)
                     '<procedure-env>))
      (if (special-procedure? object)
          (if (eq? (name-of-special-proc object) 'cons)
              (display (list
                    (force-it (apply object
                                     '((lambda(p q) p))
                                     the-global-environment))
                         'cdr-promise))                    
              (display object)))))   

效果：
;;; L-Eval input:
(cons 1 2)

;;; L-Eval output:
(1 cdr-promise)

;;; L-Eval input:
integers

;;; L-Eval output:
(1 cdr-promise)

;;; L-Eval input:
(cdr integers)

;;; L-Eval output:
(2 cdr-promise)