《The little schemer》 涂鸦🎨
阅读说明
本文算是我对 《The Little Schemer》 的读书笔记，主要是把书里的核心函数以及编写代码的原则(commandment)整理出来，并加上自己的理解。
本文有以下几个特点：
- 每章拆分成了不同小节，方便通过目录在小节之间跳转。在每一节中都加入了自己对本节代码的理解，要么体现在标题里，要么写在正文中。
- 若原文中某个函数与其他函数有相似的地方或者作者明确提及了另外一个函数，本文会尽量把两个函数一同列出，以减少回忆负担和来回跳转的频率。
- scheme 毕竟是一种 lisp 语言，为了避免 Lost in stupid parentheses, 本文给代码里的括号对都加上了彩虹色（rainbow delimiters），当光标移动在代码上时，还会匹配出最接近的表达式（S-expression），将字体放大和背景高亮，有助于提高代码可读性，尤其是嵌套较多的 Y 算子一章, 这些就像在绘制涂鸦。。
整理本文时，我先从 github 搜索到其他人分享的代码，拷贝到 org mode 的 racket src block 中， 修改代码以使得语法上和原文几乎一样，每一段都在 jupyter iracket 环境里执行并打印出结果。
源代码参考链接包括：
1 Toys
世界的本原： atom, list 和 S-expression
相传古希腊众多流派中，有一派认为世界是由无数的不可分割的小粒子（atom）构成。这些粒子在空间中移动和组合，形成了我们看到的各种物质和现象，而另外一派（毕达哥拉斯学派）则认为“一切皆数”，事物都可以用数来描述。
两派实际没有太多理论上的冲突，因为原子论是从物理角度来看世界是由什么组成的，而毕达哥拉斯学派则是尝试去"解释"组成对象，并选择"数"作为描述的符号。
由于 scheme 是一门语言，它不是物理世界本身，而是为了描述物理或想象世界的符号系统，因此更接近毕达哥拉斯派看问题的视角， 但在选择词汇上，scheme 更靠近原子论，把 atom 作为"基石", 数则是 atom 的子类。 除此之外，atom 还包括 symbol, bool 等等其他类型。
然而，世界不可能是一盘散装的 atom，还需要某种结构来组合它们，于是 scheme 创造出了 list （或者说括号）， 它是描述结构的工具。
本节引出了这些"本原"，以及判断“本原”类型的内置函数：
atom: 对应的类型判断函数是atom?, 继续细分为：number: 本书中只指代自然数symbol: 判断函数是symbol?- …
list: 对应的类型判断函数是list?S-expression: atom 和 list 的统称。因此 scheme 中，一切皆 s-expression 。(从此 scheme 也成了教派)
书本中对 atom? 的定义如下：
(define atom?
(lambda (x)
(and (not (pair? x)) (not (null? x)))))
这里还需要解释 not, pair? 和 null? ，但核心是理解 atom 不是空的，也不是多个的。
(atom? '())
#f
(atom? 'u)
#t
(list? '())
#t
(symbol? '*abc$)
#t
(atom? '*abc$)
#t
创世三件套： car, cdr 和 cons
在 scheme 中，要构造一个复合对象，只需要一个操作： cons, 要观察和分解这个对象，只需要 car 和 cdr
(cdr '(hamburger))
'()
cons
(cons 'a '(b c))
'(a b c)
(cons '(banana and) '(peanut butter and jelly))
'((banana and) peanut butter and jelly)
无法对空 list 取 car/cdr:
(car (quote ()))
car: contract violation expected: pair? given: '() context...: body of top-level
零的发现： The Law of Null?
The primitive null? is defined only for lists.
The Law of Null?
正如以上引用所说，null? 只能作用在 list 上，对 atom 是无效的，但 racket 的 null? 更广泛，只要不是空 list, 都返回 false
(null? 'a)
#f
(null? (quote ()))
#t
'() 不是 atom, 它是纯结构/形式。
这只是原书对 scheme 语言的一种约定，也可以在另一种 lisp 方言中令 '() 是 atom 类型, 只要在使用时有相应的函数进行区别即可。
The Law of Eq?
The primitive eq? takes two arguments which are non-numeric atoms. But in practice lists may be arguments as well.
The Law of Eq?
书本里的 eq? 只能判断非数字的原子（symbol, bool 等）, 不过 racket 里的 eq? 可以判断各类对象：
(eq? 'a 'b)
(define l '(beans beans we need jelly beans))
(eq? (car l) (car (cdr l)))
#t
以上是原书里的标准用法，以下都是 racket 的用法（完全可以覆盖书本用法，因此不会导致代码上的差别）
; 比较list
(eq? '() '(strawberry))
#f
; 比较数字
(eq? 6 7)
#f
(eq? (car '(Mary had a little lamb chop)) 'Mary)
#t
2 Do It, Do It Again, and Again, and Again …
这一节展现了如何细致跟踪函数，要的是耐心和多问一些问题，let's think step by step
lat?
lat? 是 list of atom? 的意思，它判断某个 list 中的元素是否都是 atom
这是对复杂度的控制，从简单的、同类型的复合对象开始， 之后再讨论可包含嵌套 list 的 list, 如：
- list of number
- list of pair
- list of s-expression
后几章中会分别讨论这些更复杂的结构
(define lat?
(lambda (l)
(cond
((null? l) #t)
((atom? (car l)) (lat? (cdr l)))
(else #f))))
(lat? '(1 2 a b c))
#t
(lat? '(1 () a b c))
#f
(lat? '())
#t
or 和 member?
or 运算：由于是短路运算，如果 or 的第一个参数为 True, 第二个就不会被执行，这类似 if not first then second. 因此 or 是自带条件分支能力的，有时候可以用 or 来化简条件分支语句
(define l1 '())
(define l2 '(d e f g))
(or (null? l1) (null? l2))
#t
(define member?
(lambda (a lat)
(cond
((null? lat) #f)
(else (or (eq? a (car lat))
(member? a (cdr lat)))))))
(define a 'tea)
(define lat '(coffee tea or milk))
(member? a lat)
#t
The First Commandment(preliminary)
Always ask null? as the first question in expressing any function.
The First Commandment(preliminary)
这意味着，所有的函数都要递归到参数是空 list 的场景。
3 Cons the Magnificent
本章介绍了许多构造 list 的函数，这类函数非常依赖 cons （因为 cons 是构造 list 的唯一手段）
rember: 删除原子序列中第一个匹配元素
rember 是 remove member 的意思，函数中有两种递归停止的分支，一种是空 list, 另一种则是查找命中
(define rember
(lambda (a lat)
(cond
((null? lat) '())
(else (cond
((eq? (car lat) a) (cdr lat))
(else (cons (car lat)
(rember a (cdr lat)))))))))
(define a 'mint)
(define lat '(lamb chops and mint jelly))
(rember a lat)
'(lamb chops and jelly)
The Second Commandment
Use cons to build lists.
The Second Commandment
firsts, seconds: 典型元素和自然递归
本节主要是想引入两个描述递归的名词：典型元素和自然递归，有了这两个概念可以更好地描述递归的"形态"/"模式"
(define firsts
(lambda (ls)
(cond
((null? ls) '())
(else
(cons (car (car ls)) (firsts (cdr ls)))))))
(define l '(((five plums) four)
(eleven green oranges)
((no) more)))
(firsts l)
'((five plums) eleven (no))
(define seconds
(lambda (ls)
(cond
((null? ls) '())
(else
(cons (car (cdr (car ls))) (seconds (cdr ls)))))))
(seconds l)
'(four green more)
seconds 和 firsts 非常相似，区别仅在于递归分支中传入 cons 的第一个参数不一样，该参数称为典型元素 typical element, 而 cons 的第二部分是递归调用，由于递归对象是 (cdr ls), 因此更接近中止条件 null? ，这部分被作者称为自然递归（natural recursion）
The Third Commandment
When building a list, describe the first typical element, and then cons it onto the natural recursion.
The Third Commandment
这可以写成：
(cons typical-element (natural-recursion))
insertR, insertL, subst: 找不同
(define insertR
(lambda (new old lat)
(cond
((null? lat) (quote ()))
(else (cond
((eq? (car lat) old)
(cons old
(cons new (cdr lat))))
(else (cons (car lat)
(insertR new old
(cdr lat)))))))))
(insertR 'jalapeno 'and '(tacos tamales and salsa))
'(tacos tamales and jalapeno salsa)
(define (insertL new old lat)
(cond
((null? lat) (quote ()))
(else (cond
((eq? (car lat) old)
(cons new
(cons old (cdr lat))))
(else (cons (car lat)
(insertL new old
(cdr lat))))))))
(insertL 'jalapeRo 'and '(tacos tamales and salsa))
'(tacos tamales jalapeRo and salsa)
R 和 L 的区别仅仅在于第二个停止条件：
(cons old
(cons new (cdr lat)))
;; VS
(cons new
(cons old (cdr lat)))
这为后文进行高阶函数抽象做了铺垫
(define (subst new old lat)
(cond
((null? lat) (quote ()))
(else (cond
((eq? (car lat) old)
(cons new (cdr lat)))
(else (cons (car lat)
(subst new old
(cdr lat))))))))
subst 相对 insertL 和 insertR 仍然只是停止条件的区别，
(define new 'vanilla)
(define o1 'chocolate)
(define o2 'banana)
(define lat '(banana ice cream with chocolate topping))
(subst new o1 lat)
'(banana ice cream with vanilla topping)
subst2: 替换 o1 或者 o2
(define (subst2 new o1 o2 lat)
(cond
((null? lat) (quote ()))
(else (cond
((or (eq? (car lat) o1) (eq? (car lat) o2))
(cons new (cdr lat)))
(else (cons (car lat)
(subst2 new o1 o2
(cdr lat))))))))
(subst2 new o1 o2 lat)
'(vanilla ice cream with chocolate topping)
本节的所有函数，递归分支的代码都是一样的，因为它们均在遍历数组，用 python 来描述的话，结构都是以下形式，只不过 action 不同
for ele in lst:
if ele == a:
action
multi- 函数
本章到目前为止介绍的都是查找到列表中第一个目标后进行特定操作的函数，本节则是对这些函数进行扩展，变成 find all + 操作
回顾 rember:
(define rember
(lambda (a lat)
(cond
((null? lat) '())
(else (cond
((eq? (car lat) a) (cdr lat))
(else (cons (car lat)
(rember a (cdr lat)))))))))
要把以上函数变成 multi 版本，那么应该在查找命中之后继续递归（把第二条停止条件分支改成递归分支）：
(define multirember
(lambda (a lat)
(cond
((null? lat) '())
(else (cond
((eq? (car lat) a)
(multirember a (cdr lat)))
(else (cons (car lat)
(multirember a (cdr lat)))))))))
(define a 'cup)
(define lat '(coffee cup tea cup and hick cup))
(multirember a lat)
'(coffee tea and hick)
同样， multiinserL 和 multiinsertR 也是把第二条停止分支改成递归分支
(define multiinsertR
(lambda (new old lat)
(cond
((null? lat) (quote ()))
(else (cond
((eq? (car lat) old)
(cons old
(cons new
(multiinsertR new old
(cdr lat)))))
(else (cons (car lat)
(multiinsertR new old
(cdr lat)))))))))
(define new 'and)
(define old 'cup)
(define lat '(coffee cup tea cup and hick cup))
(multiinsertR new old lat)
'(coffee cup and tea cup and and hick cup and)
(define (multiinsertL new old lat)
(cond
((null? lat) (quote ()))
(else (cond
((eq? (car lat) old)
(cons new
(cons old
(multiinsertL new old
(cdr lat)))))
(else (cons (car lat)
(multiinsertL new old
(cdr lat))))))))
(define new 'fried)
(define old 'fish)
(define lat '(chips and fish or fish and fried))
(multiinsertL new old lat)
'(chips and fried fish or fried fish and fried)
(define (multisubst new old lat)
(cond
((null? lat) (quote ()))
(else (cond
((eq? (car lat) old)
(cons new
(multisubst new old
(cdr lat))))
(else (cons (car lat)
(multisubst new old
(cdr lat))))))))
(define old 'fish)
(define new 'octopus)
(define lat '(chips and fish or fish and fried chips))
(multisubst new old lat)
'(chips and octopus or octopus and fried chips)
The Fourth Commandment (preliminary)
Always change at least one argument while recurring. It must be changed to be closer to termination. The changing argument must be tested in the termination condition: when using cdr, test termination with null?.
The Fourth Commandment (preliminary)
4 Numbers Games
对实用性顾虑的说明
读本章时，如果产生了某种莫名的焦虑，有可能是因为这里介绍了一种理论上（类 Peano 公理）的构建自然数的方法，所有的自然数以及自然数中的基本运算都从 zero? add1? 和 sub1? 三个操作通过递归构建，非常低效，然而，这只是一种概念证明（proof of concept）。
在大部分实用的语言中， <,>,+,-,=,/,* 都应该是直接对底层 cpu 指令集的封装，毕竟在 cpu 设计中，数字就已经在 Bit 和 Byte 粒度层面进行编码了，许多运算由硬件直接实现（加法器，浮点乘法除法器），实践中不太可能用本书里的方式去表示自然数并计算，因此正如标题所说，这只是一种构造数字的游戏，带着游戏的心态去阅读吧。
自然数的 primitive 操作
本节展现了自然数和 list 的相似性，它们几乎是同构的，如下：
- zero? 之于自然数如同 null? 之于 list
- add1 之于自然数如同 cons 之于 list
- sub1 之于自然数如同 cdr 之于 list
(define (atom? x) (or (symbol? x) (number? x)))
(atom? 14)
#t
(and (number? -3) (number? 3.14159))
#t
add1 在 racket 中是内置的
(add1 67)
68
sub1 也是
(sub1 5)
4
racket 可以支持减少到 -1, 但本章只讨论自然数（大于等于 0 的整数），因此对于小于 0 的情况，认为是没有答案或者未定义
(sub1 0)
-1
zero?
(zero? 1492)
#f
加法和减法
racket 有原生 + 法，如下
(+ 3 4)
可以通过递归的方式来实现加法，只依赖 zero?, add1 和 sub1, 利用的是 \( n+m = 1+(n+(m-1))\) 和 \( n+0=n \) 的性质
(define ➕
(lambda (n m)
(cond
((zero? m) n)
(else (add1 (➕ n (sub1 m)))))))
(➕ 46 12)
58
(sub1 m) 朝着停止条件 (zeros? m) 更进一步，这是符合 The Fourth Commandment (preliminary) 的，因此这是自然递归。
(- 1 3)
-2
减法的实现类似加法，n - m 相当于 n 和 m 同频率进行减 1 操作，当 m 到 0 的时候， n 就是最终结果（当然 m 不能是负数）
(define -
(lambda (n m)
(cond
((zero? m) n)
(else (sub1 (- n (sub1 m)))))))
(- 17 9)
8
可以看到和加法的差别仅仅在于：
(add1 (+ n (sub1 m)))
;; 改成
(sub1 (- n (sub1 m)))
非常具有对偶性质，add1 对应 +, sub1 对应 -
书本里没有提及尾递归，这里个人补充一个尾递归形式的减法：
(define -
(lambda (n m)
(cond
((zero? m) n)
(else (- (sub1 n) (sub1 m))))))
(- 17 9)
8
以及尾递归形式加法：
(define +
(lambda (n m)
(cond
((zero? m) n)
(else (+ (add1 n) (sub1 m))))))
(+ 46 12)
58
它们也是对偶的
tup ， addtup
和 lat 类似， tup 是整数数组， list of number
(define (tup? l)
(cond
((null? l) #t)
(else (and (number? (car l)) (tup? (cdr l))))))
(tup? '(2 11 3 79 47 6))
#t
(tup? '(1 2 8 apple 4 3))
#f
(tup? '())
#t
addtup 是对数字数组元素求和，相当于 python 中 sum(lst) ，它是一种对序列的 reduce 操作，或者是构建数字操作（building number）。
由于数字和 list 的相似性，addtup 与第三章中介绍的 building list 操作（如 subst,insertL,insertR）之间有很多相似性，例如 subst 中，递归终点是返回一个空 list, 即 (quote ()), 对应在 addtup 中是返回 0, 因为数字的 0 类比于空 list.
(define (addtup t)
(cond
((null? t) 0)
(else (+ (car t) (addtup (cdr t))))))
(addtup '(3 5 2 8))
18
构建 list 的时候一般要问两个问题： list 是否为空。构建 number 的时候也问两个： tup 是否为空（从 tup 中 reduce 出数字）或者 number 是否为 0 （从数字运算中构建数字）
为此总结出第 1 条原则的最终版本：
The First Commandment (first revision)
When recurring on a list of atoms, lat, ask two questions about it: ( null ? lat) and else. When recurring on a number, n , ask two questions about it: (zero ? n) and else.
The First Commandment(first revision)
The Fourth Commandment (first revision)
Always change at least one argument while recurring. It must be changed to be closer to termination. The changing argument must be tested in the termination condition: when using cdr, test termination with null? and when using sub1 , test termination with zero ?.
The Fourth Commandment (first revision)
对比 preliminary 版本：
Always change at least one argument while recurring. It must be changed to be closer to termination. The changing argument must be tested in the termination condition: when using cdr, test termination with null?.
The Fourth Commandment (preliminary)
乘法
❎ 符号表示乘法
(define (❎ n m)
(cond
((zero? m) 0)
(else (+ n (❎ n (sub1 m))))))
递归结束的时候是返回 0 而不是 1(尽管 1 似乎与乘法更配), 这是因为这里把乘法分解成了加法，在递归中构建数字的是加法，而对加法来说，0 是递归的终点，类似 '() 是 cons 的终点，
(❎ 12 3)
36
过程分解：
;; (* 12 3) = (+ 12 (* 12 2))
;; = (+ 12 (+ 12 (* 12 1)))
;; = (+ 12 (+ 12 (+ 12 (* 12 0))))
;; = (+ 12 12 12 0)
The Fifth Commandment
When building a value with + , always use 0 for the value of the terminating line, for adding 0 does not change the value of an addition. When building a value with x , always use 1 for the value of the terminating line, for multiplying by 1 does not change the value of a multiplication. When building a value with cons , always consider () for the value of the terminating line.
The Fifth Commandment
tup+
该函数等价于 python 中的：
l1, l2 = [3, 7], [4, 6]
print([x+y for x,y in zip(l1, l2)])
[7, 13]
(define tup+
(lambda (t1 t2)
(cond
((or (null? t1)
(null? t2)) '())
(else (cons (+ (car t1) (car t2))
(tup+ (cdr t1) (cdr t2)))))))
(tup+ '(3 7) '(4 6))
'(7 13)
如果要能够允许输入参数 t1 和 t2 不等长：
(define (tup+ t1 t2)
(cond
;; ((and (null? t1) (null? t2)) '()) ; Because it will be checked by one of the two following lines.
((null? t1) t2)
((null? t2) t1)
(else (cons (+ (car t1)
(car t2))
(tup+ (cdr t1)
(cdr t2))))))
(tup+ '(3 7 8 1) '(4 6))
'(7 13 8 1)
(tup+ '(3 7) '(4 6 8 1))
'(7 13 8 1)
相当于 pyton 中用 zip_longest 进行组合:
import itertools
l1, l2 = [3, 7, 8, 1], [4, 6]
print([x+y for x,y in itertools.zip_longest(l1, l2, fillvalue = 0)])
[7, 13, 8, 1]
注意，递归判断中的以下分支在后文中也经常出现，例如集合的 union, 这是一种 merge 操作常见 pattern
((null? t1) t2)
((null? t2) t1)
数之间的关系：大于和小于（偏序）
大小于的实现类似减法，都是 n 和 m 比赛谁先数到 0,
(define >
(lambda (n m)
(cond
((zero? n) #f)
((zero? m) #t)
(else (> (sub1 n) (sub1 m))))))
(> 0 0)
#f
如果 n 先数到 0, 那么 n 不可能大于 m (但有可能等于），因此 basecase 的两句话的顺序是重要的，如果交换 就变成 >= 了，以下 ≧ 是大于等于的定义
(define ≥
(lambda (n m)
(cond
((zero? m) #t)
((zero? n) #f)
(else (≥ (sub1 n) (sub1 m))))))
(≥ 0 0)
#t
(> 1 0)
#t
以上是尾递归形式，列出减法（尾递归）实现作为对比：
(define -
(lambda (n m)
(cond
((zero? m) n)
(else (- (sub1 n) (sub1 m))))))
可以看到，差别也只是在 basecase 判断部分。
小于：
(define <
(lambda (n m)
(cond
((zero? m) #f)
((zero? n) #t)
(else (< (sub1 n) (sub1 m))))))
(< 0 0)
#f
(< 8 3)
#f
数之间的关系：等于（等价）
(define (== n m)
(cond
((and (zero? m) (zero? n)) #t)
((zero? m) #f)
((zero? n) #f)
(else (== (sub1 m) (sub1 n)))))
(== 4 3)
#f
(== 9 9)
#t
通过大于和小于实现
(define (== n m)
(cond
((or (> n m) (< n m)) #f)
(else #t)))
(== 4 3)
#f
(== 9 9)
#t
乘方和除法
(define (⬆️ n m)
(cond
((zero? m) 1)
(else (❎ n (⬆️ n (sub1 m))))))
(⬆️ 1 1)
1
(⬆️ 2 3)
8
对比乘法的实现，basecase 返回的是 1, 并且用乘法作为 cons 操作
(define (❎ n m)
(cond
((zero? m) 0)
(else (+ n (❎ n (sub1 m))))))
除法实现中，不断从 n 中减去 m, 然后计算 n 被减到 0 的次数
(define ➗
(lambda (n m)
(cond
((< n m) 0)
(else (add1 (➗ (- n m) m))))))
(➗ 15 4)
3
racket 中 / 会得到分数
(/ 15 4)
15/4
整除要用 quotient
(quotient 15 4)
3
数组操作
(define length
(lambda (lat)
(cond
((null? lat) 0)
(else (add1 (length (cdr lat)))))))
(length '(hotdogs with mustard sauerkraut and pickles))
6
(define (pick n lat)
(cond
((= n 1) (car lat))
(else (pick (sub1 n) (cdr lat)))))
(pick 4 '(lasagna spahghetti ravioli macaroni meatball))
'macaroni
以下会陷入无限循环（书本中是无定义）
(pick 0 '(a))
(define rempick
(lambda (n lat)
(cond
((zero? (sub1 n)) (cdr lat))
(else (cons (car lat)
(rempick (sub1 n) (cdr lat)))))))
(rempick 3 '(hotdogs with hot mustard))
'(hotdogs with mustard)
对比 rember:
(define rember
(lambda (a lat)
(cond
((null? lat) '())
(else (cond
((eq? (car lat) a) (cdr lat))
(else (cons (car lat)
(rember a (cdr lat)))))))))
number? add1, sub1, zero?, car, cdr, cons, null?, eq?, and atom? are primitive functions.
(define no-nums
(lambda (lat)
(cond
((null? lat) '())
((number? (car lat))
(no-nums (cdr lat)))
(else (cons (car lat)
(no-nums (cdr lat)))))))
(no-nums '(5 pears 6 prunes 9 dates))
'(pears prunes dates)
(define all-nums
(lambda (lat)
(cond
((null? lat) (quote ()))
(else
(cond
((number? (car lat))
(cons (car lat)
(all-nums ( cdr lat))))
(else ( all-nums ( cdr lat))))))))
(all-nums '(5 pears 6 prunes 9 dates))
'(5 6 9)
eqan? ：比较 atom （数字和 symbol)
eqan? 是为了泛化而设计，可以判断数字或者 symbol 之间是否相等，全名 atom-equal?
(define eqan?
(lambda (a1 a2)
(cond
((and (number? a1) (number? a2)) (= a1 a2))
((or (number? a1) (number? a2)) #f)
(else (eq? a1 a2)))))
(eqan? 'potato 'potato)
#t
(eqan? 'potato 'tomato)
#f
统计元素出现频率
(define occur
(lambda (a lat)
(cond
((null? lat) 0)
((eq? a (car lat))
(add1 (occur a (cdr lat))))
(else (occur a (cdr lat))))))
(occur 'potato '(potato sandwich))
1
(define (one? n) (= n 1))
(one? 1)
#t
(one? 3)
#f
(define rempick
(lambda (n lat)
(cond
((one? n) (cdr lat))
(else (cons (car lat)
(rempick (sub1 n) (cdr lat)))))))
(rempick 3 '(potato and tomato salad))
'(potato and salad)
对比之前的实现，这里展现的是可以用自定义函数 one 对常用语句进行封装
(define rempick
(lambda (n lat)
(cond
((zero? (sub1 n)) (cdr lat))
(else (cons (car lat)
(rempick (sub1 n) (cdr lat)))))))
(rempick 3 '(potato and tomato salad))
'(potato and salad)
5 *Oh My Gawd*: It's Full of Stars
到目前为止介绍的函数中，递归分支里只执行一次递归调用，可以称为线性递归，本章开始则进入树递归，类似从一维空间上升到了二维空间
rember*
The rember* function removes all matching atoms from a list of s-expression
注意 list of s-expression 的说法： 它不等于 list of atom （缩写是 lat），因为 s-expression 即可以是 list 也可以是 atom, list of atom 或者 list of number 只有长度（宽度），但 list of s-expression 蕴含着另一个维度 – 嵌套深度的存在。
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) a)
(rember* a (cdr l)))
(else (cons (car l)
(rember* a (cdr l))))))
(else
(cons (rember* a (car l)) (rember* a (cdr l)))))))
(rember*
'cup
'((coffee) cup ((tea) cup) (and (hick)) cup))
'((coffee) ((tea)) (and (hick)))
(rember*
'sauce
'(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce)))
'(((tomato)) ((bean)) (and ((flying))))
以下是 multirember 的代码，作为对比，当 (car l) 是 atom 时， rember* 的代码和以下是一样的，
rember* 比 multirember 多最后两行
(define multirember
(lambda (a lat)
(cond
((null? lat) '())
(else (cond
((eq? (car lat) a)
(multirember a (cdr lat)))
(else (cons (car lat)
(multirember a (cdr lat)))))))))
(define insertR*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) old)
(cons old (cons new (insertR* new old (cdr l)))))
(else
(cons (car l) (insertR* new old (cdr l))))))
(else
(cons (insertR* new old (car l)) (insertR* new old (cdr l)))))))
(insertR*
'roast
'chuck
'((how much (wood)) could ((a (wood) chuck)) (((chuck)))
(if (a) ((wood chuck))) could chuck wood))
'((how much (wood)) could ((a (wood) chuck roast)) (((chuck roast))) (if (a) ((wood chuck roast))) could chuck roast wood)
作为对比， multiinsertR 如下，注意 multiinsertR* 最后两行差异
(define (multiinsertR new old lat)
(cond
((null? lat) (quote ()))
(else (cond
((eq? (car lat) old)
(cons old
(cons new
(multiinsertR new old
(cdr lat)))))
(else (cons (car lat)
(multiinsertR new old
(cdr lat))))))))
The first commandment (final version)
When recurring on a list of atoms, lat, ask two questions about it: (null? lat) and else.
When recurring on a number, n, ask two questions about it: (zero? n) and else.
When recurring on a list of S-expressions, l, ask three questions about it: (null? l), (atom? (car l)), and else.
– The first commandment (final version)
描述了在三种结构上递归的 pattern：
- list of atom
- number
- list of S-expression
The fourth commandment (final version)
第四条原则是解释自然递归部分的逻辑：
Always change at least one argument while recurring.
When recurring on a list of atoms, lat, use (cdr l).
When recurring on a number, n, use (sub1 n).
And when recurring on a list of S-expressions, l, use (car l) and (cdr l) if neither (null? l) nor (atom? (car l)) are true.
It must be changed to be closer to termination. The changing argument must be tested in the termination condition:
- when using cdr, test the termination with null? and
- when using sub1, test termination with zero?.
– The fourth commandment (final version)
occur*, subst*, insertL*, member*
统计嵌套 list 中的 atom 的个数
(define occur*
(lambda (a l)
(cond
((null? l) 0)
((atom? (car l))
(cond
((eq? (car l) a)
(add1 (occur* a (cdr l))))
(else
(occur* a (cdr l)))))
(else
(+ (occur* a (car l))
(occur* a (cdr l)))))))
(occur*
'banana
'((banana)
(split ((((banana ice)))
(cream (banana))
sherbet))
(banana)
(bread)
(banana brandy)))
5
替换 list 里所有命中的元素
(define subst*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) old)
(cons new (subst* new old (cdr l))))
(else
(cons (car l) (subst* new old (cdr l))))))
(else
(cons (subst* new old (car l)) (subst* new old (cdr l)))))))
(subst*
'orange
'banana
'((banana)
(split ((((banana ice)))
(cream (banana))
sherbet))
(banana)
(bread)
(banana brandy)))
'((orange) (split ((((orange ice))) (cream (orange)) sherbet)) (orange) (bread) (orange brandy))
(define insertL*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) old)
(cons new (cons old (insertL* new old (cdr l)))))
(else
(cons (car l) (insertL* new old (cdr l))))))
(else
(cons (insertL* new old (car l)) (insertL* new old (cdr l)))))))
(insertL*
'pecker
'chuck
'((how much (wood)) could ((a (wood) chuck)) (((chuck)))
(if (a) ((wood chuck))) could chuck wood))
'((how much (wood)) could ((a (wood) pecker chuck)) (((pecker chuck))) (if (a) ((wood pecker chuck))) could pecker chuck wood)
(define member*
(lambda (a l)
(cond
((null? l) #f)
((atom? (car l))
(or (eq? (car l) a)
(member* a (cdr l))))
(else
(or (member* a (car l))
(member* a (cdr l)))))))
(member*
'chips
'((potato) (chips ((with) fish) (chips))))
#t
leftmost: 只在第二维度上递归
前文里介绍的带有 * 的函数都是把在深度和宽度两个方向上递归的结果组合起来，而 leftmost 则只在 (car lst) 维度上递归。 leftmost 要求最左侧叶子节点（不断取第一个元素的第一个元素）一定是 atom, 不能是空 list.
(define leftmost
(lambda (l)
(cond
((atom? (car l)) (car l))
(else (leftmost (car l))))))
(leftmost '((potato) (chips ((with) fish) (chips))))
'potato
(leftmost '(((hot) (tuna (and))) cheese))
'hot
no-answer 的例子（error）：
(leftmost '(((() four)) 17 (seventeen)))
(leftmost '())
car: contract violation expected: pair? given: '() context...: body of top-level /home/pipz/.local/share/racket/pkgs/sandbox-lib/racket/sandbox.rkt:710:9: loop
list of s-expression 的比较
本节介绍比较两个 s-expression 是否相等的函数，不过这部分真正的价值在于作者展现了如何简化一个程序的过程
(or a b) 等价于 (cond (a #t) (else b))
(and a b) 等价于 (cond (a b) (else #f))
可以用以上等价对 cond 进行化简
要对比两个 list 是否等价, 需要问 9 个问题，因为 list 有三种形态：空 list, 第一个元素是 atom 或者第一个元素是 list，因此上文中带 star 的函数只是对一个 list 进行递归，就需要三个问题，对两个 list 递归则要 9 个问题，以下是最暴力的写法（也是按照分析得到的最清晰的写法）：
(define eqlist?
(lambda (l1 l2)
(cond
; case 1: l1 is empty, l2 is empty, atom, list
((and (null? l1) (null? l2)) #t)
((and (null? l1) (atom? (car l2))) #f)
((null? l1) #f)
; case 2: l1 is atom, l2 is empty, atom, list
((and (atom? (car l1)) (null? l2)) #f)
((and (atom? (car l1)) (atom? (car l2)))
(and (eq? (car l1) (car l2))
(eqlist? (cdr l1) (cdr l2))))
((atom? (car l1)) #f)
; case 3: l1 is a list, l2 is empty, atom, list
((null? l2) #f)
((atom? (car l2)) #f)
(else
(and (eqlist? (car l1) (car l2))
(eqlist? (cdr l1) (cdr l2)))))))
(eqlist?
'(strawberry ice cream)
'(strawberry ice cream))
#t
(eqlist?
'(strawberry ice cream)
'(strawberry cream ice))
#f
(eqlist?
'(banan ((split)))
'((banana) split))
#f
用 or 来进行一些化简后的写法
(define eqlist2?
(lambda (l1 l2)
(cond
; case 1: l1 is empty, l2 is empty, atom, list
((and (null? l1) (null? l2)) #t)
((or (null? l1) (null? l2)) #f)
; case 2: l1 is atom, l2 is empty, atom, list
((and (atom? (car l1)) (atom? (car l2)))
(and (eq? (car l1) (car l2))
(eqlist2? (cdr l1) (cdr l2))))
((or (atom? (car l1)) (atom? (car l2)))
#f)
; case 3: l1 is a list, l2 is empty, atom, list
(else
(and (eqlist2? (car l1) (car l2))
(eqlist2? (cdr l1) (cdr l2)))))))
(eqlist2?
'(strawberry ice cream)
'(strawberry ice cream))
#t
(eqlist2?
'(banan ((split)))
'((banana) split))
#f
(eqlist2?
'(beef ((sausage)) (and (soda)))
'(beef ((salami)) (and (soda))))
#f
s-expression 的比较
注意这和上一节的区别，继续不厌其烦地提醒：
- list of s-expression 相当于一般意义上的 list
s-expression 有可能是 atom, 如果两者都是 atom, 那么可以用专门比较 atom 的 eqan? 进行
(define eqan? (lambda (a1 a2) (cond ((and (number? a1) (number? a2)) (= a1 a2)) ((or (number? a1) (number? a2)) #f) (else (eq? a1 a2)))))
如果是都是 list, 则用 eqlist? 进行比较，如果要更通用，则需定义：
(define equal?
(lambda (s1 s2)
(cond
((and (atom? s1) (atom? s2))
(eqan? s1 s2))
((atom? s1) #f)
((atom? s2) #f)
(else (eqlist? s1 s2)))))
由于 scheme 中一切都都是 s-expression ， 因此 equal? 是最通用的等价判断函数
(equal? 'a 'a)
#t
(equal? 'a 'b)
#f
(equal? '(a (b c)) '(a (b c)))
#t
(equal? '(a ()) '(a ()))
#t
用 or 进行化简：
(define equal?
(lambda (s1 s2)
(cond
((and (atom? s1) (atom? s2))
(eqan? s1 s2))
((or (atom? s1) (atom? s2)) #f)
(else (eqlist? s1 s2)))))
用 equal? 重写 eqlist?, 这里相互递归了，循环定义并不会导致问题，因为每次都是在缩小规模：
(define eqlist?
(lambda (l1 l2)
(cond
((and (null? l1) (null? l2)) #t)
((or (null? l1) (null? l2)) #f)
(else
(and (equal? (car l1) (car l2))
(equal? (cdr l1) (cdr l2)))))))
(eqlist?
'(strawberry ice cream)
'(strawberry ice cream))
#t
(eqlist?
'(beef ((sausage)) (and (soda)))
'(beef ((salami)) (and (soda))))
#f
The sixth commandment
Simplify only after the function is correct.
The sixth commandment
一个更加通用的 rember
用通用的 equal? 函数替换了之前的 eq?
(define rember
(lambda (s l)
(cond
((null? l) '())
((equal? (car l) s) (cdr l))
(else (cons (car l) (rember s (cdr l)))))))
(rember
'(foo (bar (baz)))
'(apples (foo (bar (baz))) oranges))
'(apples oranges)
这是之前定义的 rember 相关函数，它们都只能查找 atom 类型的对象
(define rember
(lambda (a lat)
(cond
((null? lat) '())
(else (cond
((eq? (car lat) a) (cdr lat))
(else (cons (car lat)
(rember a (cdr lat)))))))))
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) a)
(rember* a (cdr l)))
(else
(cons (car l) (rember* a (cdr l))))))
(else
(cons (rember* a (car l)) (rember* a (cdr l)))))))
当然还可以吧 rember* 变成更加通用。
6 Shadows
本节算是实现了一个计算器，并且引入编程中抽象的概念和方法
公式的语法判断
在一个简单的计算器中，用户只能输入数字， (a x b), （a + b），（a ^ b）， 其中 a,b 也只能是这四形式 以下是判断该表达式是否合法的函数：
(define numbered?
(lambda (aexp)
(cond
((atom? aexp) (number? aexp))
((eq? (car (cdr aexp)) '+)
(and (numbered? (car aexp))
(numbered? (car (cdr (cdr aexp))))))
((eq? (car (cdr aexp)) 'x)
(and (numbered? (car aexp))
(numbered? (car (cdr (cdr aexp))))))
((eq? (car (cdr aexp)) '^)
(and (numbered? (car aexp))
(numbered? (car (cdr (cdr aexp))))))
(else #f))))
(numbered? '((5 + 2) x (3 ^ 2)))
#t
(numbered? '(5 + 5))
#t
(numbered? '5)
#t
(numbered? '(2 x sausage))
#f
如果输入的公式 aexp 本身已经做过一次检查，是"合理"的公式（例如是前缀，中缀或后缀形式之一），那么 numbered? 可以只判断它是否是当前期望的形式，例如以下判断是否为中缀形式：
(define numbered?
(lambda (aexp)
(cond
((atom? aexp) (number? aexp))
(else
(and (numbered? (car aexp))
(numbered? (car (cdr (cdr aexp)))))))))
以上 numbered? 会把 (1 2 3) 判断为正确，但这是因为输入本身不"合理"
(numbered? '(1 2 3))
#t
The seventh commandment
Recur on the subparts that are of the same nature:
- On the sublists of a list.
- On the subexpressions of an arithmetic expression.
The seventh commandment
公式的语义计算
The value function determines the value of an arithmetic expression
(define value
(lambda (nexp)
(cond
((atom? nexp) nexp)
((eq? (car (cdr nexp)) '+)
(+ (value (car nexp))
(value (car (cdr (cdr nexp))))))
((eq? (car (cdr nexp)) 'x)
(* (value (car nexp))
(value (car (cdr (cdr nexp))))))
((eq? (car (cdr nexp)) '^)
(expt (value (car nexp))
(value (car (cdr (cdr nexp))))))
(else #f))))
(value '(1 + (3 ^ 4)))
82
(value 13)
前缀表达式的 eval 函数：
(define value-prefix
(lambda (nexp)
(cond
((atom? nexp) nexp)
((eq? (car nexp) '➕)
(+ (value-prefix (car (cdr nexp)))
(value-prefix (car (cdr (cdr nexp))))))
((eq? (car nexp) '❎)
(* (value-prefix (car (cdr nexp)))
(value-prefix (car (cdr (cdr nexp))))))
((eq? (car nexp) '^)
(expt (value-prefix (car (cdr nexp)))
(value-prefix (car (cdr (cdr nexp))))))
(else #f))))
(value-prefix '(➕ 1 (^ 3 4)))
82
可以把 value 和 value-prefix 代码经常重复出现的部分提取出来封装成函数，并且赋予一个更好的名称：
(define 1st-sub-exp
(lambda (aexp)
(car (cdr aexp))))
(define 2nd-sub-exp
(lambda (aexp)
(car (cdr (cdr aexp)))))
(define operator
(lambda (aexp)
(car aexp)))
用自定义函数重写:
(define value-prefix-helper
(lambda (nexp)
(cond
((atom? nexp) nexp)
((eq? (operator nexp) '+)
(+ (value-prefix (1st-sub-exp nexp))
(value-prefix (2nd-sub-exp nexp))))
((eq? (car nexp) '❎)
(* (value-prefix (1st-sub-exp nexp))
(value-prefix (2nd-sub-exp nexp))))
((eq? (car nexp) '^)
(expt (value-prefix (1st-sub-exp nexp))
(value-prefix (2nd-sub-exp nexp))))
(else #f))))
(value-prefix-helper '(+ 1 (^ 3 4)))
82
此时只需要重新实现这些底层函数就可以改变输入公式的形式，以下是前缀表达式的 eval 函数的接口实现：
(define 1st-sub-exp
(lambda (aexp)
(car aexp)))
(define 2nd-sub-exp
(lambda (aexp)
(car (cdr (cdr aexp)))))
(define operator
(lambda (aexp)
(car (cdr aexp))))
(value-prefix '(➕ 1 (^ 3 4)))
82
The eighth commandment
Use help functions to abstract from representations.
The eighth commandment
抽象的例子：用 list 表示整数
前文中讨论过，数字和 list 是很像的，zero? 对应 null?, add1 对应 cons, sub1 对应 cdr
而本节再进一步，直接用 list 来作为自然数的表征
() for zero, (()) for one, (() ()) for two, (() () ()) for three, etc.
(define sero?
(lambda (n)
(null? n)))
(define edd1
(lambda (n)
(cons '() n)))
(define zub1
(lambda (n)
(cdr n)))
(define ➕
(lambda (n m)
(cond
((sero? m) n)
(else
(edd1 (➕ n (zub1 m)))))))
(➕ '(() ()) '(() ()))
'(() () () ())
实际上, ➕ 就相当于 list concat 或者 append 函数，racket 中内置了 append:
(append '(() ()) '(() ()))
'(() () () ())
lat? 是第二章介绍的函数，判断某个 list 是否都是 atom, 如下
(define lat?
(lambda (l)
(cond
((null? l) #t)
((atom? (car l)) (lat? (cdr l)))
(else #f))))
(lat? '(1 2 3))
#t
如果用它来判断本节介绍的 list 表示的数，就会大错特错：
(lat? '((()) (()()) (()()())))
#f
这里需要把 atom? 修改成一个类似 is_list_number? 的函数，检查 (car l) 是否是一个 list 表示的数：
(define is_list_number?
(lambda (l)
(cond
((null? l) #t)
((null? (car l)) (is_list_number? (cdr l)))
(else #f))))
(define tat?
(lambda (l)
(cond
((null? l) #t)
((is_list_number? (car l))
(tat? (cdr l)))
(else #f))))
(tat? '((()) (()()) (()()())))
#t
7 Friends and Relations
本章用 scheme 展现了一些集合论中概念： 包含，交集，并集，差集，关系，函数，一一映射函数 这些函数中，有许多呈现出相似性（或者叫对偶性），例如
- 集合相等和数字相等
subset?和intersect?- 交集和并集本身是对偶的，然后他们杂交得到了差集
atom 和集合
没有重复元素的 list of atom 就是集合
例如 '(apple peaches apple plum) 不是集合
引入一些依赖函数：来自第一章的 atom?
(define atom?
(lambda (x)
(and (not (pair? x)) (not (null? x)))))
来自第二章的 member?
(define member?
(lambda (a lat)
(cond
((null? lat) #f)
(else (or (eq? (car lat) a)
(member? a (cdr lat)))))))
(define set?
(lambda (lat)
(cond
((null? lat) #t)
((member? (car lat) (cdr lat)) #f)
(else
(set? (cdr lat))))))
(set? '(apples peaches pears plums))
#t
(set? '(apple 3 pear 4 9 apple 3 4))
#f
makeset 接受一个 list of lat 并去除重复
(define makeset
(lambda (lat)
(cond
((null? lat) (quote ()))
((member? (car lat) (cdr lat))
(makeset (cdr lat)))
(else (cons (car lat)
(makeset (cdr lat)))))))
(makeset '(apple peach pear peach plum apple lemon peach))
'(pear plum apple lemon peach)
通过第三章定义的 multirember 来重新定义 makeset,
(define multirember
(lambda (a lat)
(cond
((null? lat) '())
((eq? (car lat) a)
(multirember a (cdr lat)))
(else (cons (car lat)
(multirember a (cdr lat)))))))
(define makeset
(lambda (lat)
(cond
((null? lat) '())
(else (cons (car lat)
(makeset
(multirember (car lat)
(cdr lat))))))))
(makeset '(apple peach pear peach plum apple lemon peach))
'(apple peach pear plum lemon)
集合之间的关系
子集关系：
(define subset?
(lambda (set1 set2)
(cond
((null? set1) #t)
((member? (car set1) set2)
(subset? (cdr set1) set2))
(else #f))))
(subset? '(5 chicken wings)
'(5 hamburgers 2 pieces fried
chicken and light duckling wings))
#t
用 and 对 subset? 中的 cond 分支进行化简
(define subset?
(lambda (set1 set2)
(cond
((null? set1) #t)
(else (and (member? (car set1) set2)
(subset? (cdr set1) set2))))))
(subset? '(4 pounds of horseradish)
'(four pounds of chicken and
5 ounces of horseradish))
#f
判断集合是否相等：这类似于第五章通过大于和小于构造 数之间的关系：等于（等价）
(define eqset?
(lambda (set1 set2)
(and (subset? set1 set2)
(subset? set2 set1))))
(eqset? '(a b c) '(c b a)) ; #t
#t
(eqset? '(a b c) '(a b)) ; #f
#f
判断两个集合是否相交集：遍历 A 中所有 atom, 如果有一个在 B 中则返回 True, 否则对 (car A) 继续递归
(define intersect?
(lambda (set1 set2)
(cond
((null? set1) #f)
((member? (car set1) set2) #t)
(else
(intersect? (cdr set1) set2)))))
(intersect?
'(stewed tomatoes and macaroni)
'(macaroni and cheese))
#t
(define intersect?
(lambda (set1 set2)
(cond
((null? set1) #f)
(else (or (member? (car set1) set2)
(intersect? (cdr set1) set2))))))
#t
注意它和 subset? 的相似性，终止条件里一个返回 True, 另一个返回 False, 自然递归中，一个是 or 连接， 另外一个用 and 连接。
(define subset?
(lambda (set1 set2)
(cond
((null? set1) #t)
(else (and (member? (car set1) set2)
(subset? (cdr set1) set2))))))
不过这种对称性似乎没有深层意义，仅仅是展现出一点美感？
intersect? 样例：
(intersect?
'(stewed tomatoes and macaroni)
'(macaroni and cheese))
#t
集合映射函数
上一节是关于两个集合之间的关系的函数（返回值是 True 或 False），本节则是输入集合，返回新的集合的函数
交集：如果 A 的第一个元素 a 是 B 中的元素，那么 (cdr A) 和 B 的交集中必然不会包含 a(因为 A 的剩余元素中不可能还包含 a), 因此这个时候 a 要和自然递归部分 cons 起来。如果 a 不是 B 中的元素，那么应该舍弃 a 。对于 basecase, 当 A 是空集，应该返回空，因为空集和任何集合的交集都是空。
后文函数参数 set1 set2 分别对应文字描述中的 A 和 B.
(define intersect
(lambda (set1 set2)
(cond
((null? set1) '())
((member? (car set1) set2)
(cons (car set1)
(intersect (cdr set1) set2)))
(else (intersect (cdr set1) set2)))))
(intersect
'(stewed tomatoes and macaroni)
'(macaroni and cheese))
'(and macaroni)
并集：如果 A 的第一个元素 a 是 B 中的元素，那么 (cdr A) 和 B 的并集中必然还会包含 a, 因此这个时候要舍弃 a, 直接进入自然递归部分, 如果 a 不是 B 中的元素，那么将 a 和自然递归部分 cons 起来。对于 basecase, 如果 A 是空集，那么应该返回 B.(这是并的定义)
(define union
(lambda (set1 set2)
(cond
((null? set1) set2)
((member? (car set1) set2)
(union (cdr set1) set2))
(else (cons (car set1)
(union (cdr set1) set2))))))
(union
'(stewed tomatoes and macaroni casserole)
'(macaroni and cheese))
'(stewed tomatoes casserole macaroni and cheese)
差集：表示在 A 中但不在 B 中的元素，因此如果 A 的第一个元素 a 在 B 中，那么应该舍弃它，直接进入自然递归部分，如果 a 不在 B 中，那么应该保留。 因此在递归逻辑部分， 差集算法完全等同 union. 在 basecase 部分，如果 A 是空，那么应该返回空集。
所以差集的实现是结合了交集的 basecase 部分和并集的自然递归部分，可谓移花接木。
(define xxx
(lambda (set1 set2)
(cond
((null? set1) '())
((member? (car set1) set2)
(xxx (cdr set1) set2))
(else
(cons (car set1) (xxx (cdr set1) set2))))))
(xxx '(a b c) '(a b d e f))
'(c)
intersectall 求出 list of set 的并，相当于 python 中以下实现
from functools import reduce
print(reduce(lambda set1,set2: set1 & set2, [{1,2,3},{3,5},{3,7}]))
{3}
(define intersectall
(lambda (l-set)
(cond
((null? (cdr l-set)) (car l-set))
(else
(intersect (car l-set) (intersectall (cdr l-set)))))))
(intersectall
'((6 pears and)
(3 peaches and 6 peppers)
(8 pears and 6 plums)
(and 6 prunes with some apples)))
'(6 and)
关系和函数
atom? 是判断某个对象是否是原子，本节引出的 a-pair? 是判断某个对象是否是长度为 2 的 list, 称为 pair
等价于 racket 内置的 pair?
(define a-pair?
(lambda (x)
(cond
((atom? x) #f)
((null? x) #f)
((null? (cdr x)) #f)
((null? (cdr (cdr x))) #t)
(else #f))))
(a-pair? '(full (house)))
#t
(a-pair? '(a b c))
#f
操作 pair 的接口函数（first 和 second 是 getter, build 是 pair 的构造函数）
(define first
(lambda (p)
(car p)))
(define second
(lambda (p)
(car (cdr p))))
(define build
(lambda (s1 s2)
(cons s1 (cons s2 '()))))
third 不属于 pair 的接口，只是一个示例（必须数完 1,2,3)
(define third
(lambda (l)
(car (cdr (cdr l)))))
关系的定义： a set of pairs, 以下两个 list 不是 relation, 第一个 list 中元素不是 pair, 第二个 list 中有重复元素，不是 set.
'(apples peaches pumpkins pie)
'((apples peaches) (pumpkin pie) (apples peaches))
以下两个 list 是关系
'((apples peaches) (pumpkin pie))
'((4 3) (4 2) (7 6) (6 2) (3 4))
再复述一遍：关系只是一个 list, 并且 list 里都是不重复的 pair.
函数是一种特殊的关系：用第三章引入的 firsts 函数取出关系中每个 pair 的第一个元素组成的列表，该列表里不允许有重复元素，换成数学的语言就是不能有一对多的场景。
有了函数的定义，就可以说出定义域和值域了： (firsts rel) 是定义域， (firsts rel) 是值域
(define firsts
(lambda (l)
(cond
((null? l) '())
(else
(cons (car (car l)) (firsts (cdr l)))))))
(define fun?
(lambda (rel)
(set? (firsts rel))))
(fun? '((4 3) (4 2) (7 6) (6 2) (3 4)))
#f
(fun? '((8 3) (4 2) (7 6) (6 2) (3 4)))
#t
函数的逆：交换定义域和值域
(define revrel
(lambda (rel)
(cond
((null? rel) '())
(else (cons (build
(second (car rel))
(first (car rel)))
(revrel (cdr rel)))))))
(revrel '((8 a) (pumpkin pie) (got sick)))
'((a 8) (pie pumpkin) (sick got))
为了化简 revrel 函数，引入一个 revpair 函数，抽象出了以上函数中 cons 的第一个参数
(define revpair
(lambda (p)
(build (second p) (first p))))
(define revrel
(lambda (rel)
(cond
((null? rel) '())
(else (cons (revpair (car rel)) (revrel (cdr rel)))))))
(revrel '((8 a) (pumpkin pie) (got sick)))
'((a 8) (pie pumpkin) (sick got))
fullfun? 判断是否为完全函数，完全函数的值域中不包括重复元素，这意味着定义域到值域是一一映射
因此此处借用了第三章提到的 seconds 函数
(define seconds
(lambda (l)
(cond
((null? l) '())
(else
(cons (second (car l)) (seconds (cdr l)))))))
(define fullfun?
(lambda (fun)
(set? (seconds fun))))
(fullfun? '((grape raisin)
(plum prune)
(stewed prune)))
#f
(fullfun? '((8 3) (4 2) (7 6) (6 2) (3 4)))
#f
(fullfun? '((8 3) (4 8) (7 6) (6 2) (3 4)))
#t
完全函数是一对一映射，也就是函数的逆也是函数。
(define one-to-one?
(lambda (fun)
(fun? (revrel fun))))
(one-to-one? '((chocolate chip) (doughy cookie)))
#t
(one-to-one? '((8 3) (4 8) (7 6) (6 2) (3 4)))
#t
8 Lambda the Ultimate
本章主要是在在展现高阶函数的构造，这是一种抽象方式， 要始终把函数（代码片段）看作和数据一样的对象，可以参数化，也可以像 list 一样作为一个存储数据的结构，这在 continuation 中被充分展现。
curry 化：函数也可以作为数据结构
把 rember 中用到的 eq? 函数提取出来作为参数：
(define rember-f
(lambda (test? a l)
(cond
((null? l) '())
((test? (car l) a) (cdr l))
(else (cons
(car l)
(rember-f test? a
(cdr l)))))))
(rember-f eq? 2 '(1 2 3 4 5))
'(1 3 4 5)
eq?-c 像一个盒子
(define eq?-c
(lambda (a)
(lambda (x)
(eq? a x))))
((eq?-c 'tuna) 'tuna)
可以把某个对象装进盒子里去：
(define eq?-salad (eq?-c 'salad))
(eq?-salad 'salad)
#t
例如以上把沙拉装到了盒子，于是盒子就变成专门检查是否等于 salad 的函数了。 把高阶函数看作盒子（或者 list）对理解之后的 CPS 形式的代码有所帮助。
把原本输入三个参数的 rember-f 修改成高阶函数的形式（curry 化）
(define rember-f
(lambda (test?)
(lambda (a l)
(cond
((null? l) '())
((test? (car l) a) (cdr l))
(else
(cons (car l) ((rember-f test?) a (cdr l))))))))
((rember-f eq?) 2 '(1 2 3 4 5))
'(1 3 4 5)
以下代码中，执行了 (rember-f eq?) 后得到一个新的函数，这个函数像一个盒子，因为其中装了一个 eq? 对象，这种带有内部数据的函数称为闭包，再次强调：它即有函数的性质（表示执行过程），又有数据结构的性质（可以存数据）。
(define rember-eq? (rember-f eq?))
(rember-eq? 'tuna '(shrimp salad and tuna salad))
'(shrimp salad and salad)
(rember-eq? 'eq? '(equal? eq? eqan? eqlist? eqpair?))
'(equal? eqan? eqlist? eqpair?)
继续 curry 化第三章介绍的 insertL 函数
(define insertL-f
(lambda (test?)
(lambda (new old l)
(cond
((null? l) '())
((test? (car l) old)
(cons new (cons old (cdr l))))
(else
(cons (car l) ((insertL-f test?) new old (cdr l))))))))
((insertL-f eq?)
'd
'e
'(a b c e f g d h))
'(a b c d e f g d h)
curry 化 insertR 函数
(define insertR-f
(lambda (test?)
(lambda (new old l)
(cond
((null? l) '())
((test? (car l) old)
(cons old (cons new (cdr l))))
(else
(cons (car l) ((insertR-f test?) new old (cdr l))))))))
((insertR-f eq?)
'e
'd
'(a b c d f g d h))
'(a b c d e f g d h)
以上两个例子中，都是把 eq? 装进了闭包（盒子），因为当前我们只是把原本的 eq? 提取出来，但还可以提取更多：
把插入元素的功能代码抽取出来做成函数：
(define seqL
(lambda (new old l)
(cons new (cons old l))))
(define seqR
(lambda (new old l)
(cons old (cons new l))))
用 curry 化方式创建新的插入函数，这里，创建函数的工作更加自动化了，原本是人手写的，现在只需要调用一个函数。
(define insert-g
(lambda (seq)
(lambda (new old l)
(cond
((null? l) '())
((eq? (car l) old)
(seq new old (cdr l)))
(else
(cons (car l) ((insert-g seq) new old (cdr l))))))))
(define insertL (insert-g seqL))
(insertL
'd
'e
'(a b c e f g d h))
'(a b c d e f g d h)
(define insertR (insert-g seqR))
(insertR
'e
'd
'(a b c d f g d h))
'(a b c d e f g d h)
可以直接传入匿名函数来构造新的函数：
(define insertL
(insert-g
(lambda (new old l)
(cons new (cons old l)))))
继续抽象第三章介绍的 subst 函数
(define subst
(lambda (new old l)
(cond
((null? l) '())
((eq? (car l) old)
(cons new (cdr l)))
(else
(cons (car l) (subst new old (cdr l)))))))
它的和 insert 函数的区别仅仅是 eq? 判断为 #t 的分支，而这个分支的代码已经被提取成参数了，因此只需要把 subset 里此部分代码做成函数传进去即可。
(define seqS
(lambda (new old l)
(cons new l)))
(define subst (insert-g seqS))
(subst
'topping
'fudge
'(ice cream with fudge for dessert))
'(ice cream with topping for dessert)
如果 eq? 判断为 #t 的分支是 seqrem, 那么把这个函数传给 insert-g 得到什么？
(define seqrem
(lambda (new old l)
l))
(define yyy
(lambda (a l)
((insert-g seqrem) #f a l)))
(yyy
'sausage
'(pizza with sausage and bacon))
'(pizza with and bacon)
seqrem 表示当遇到等于 old 的 (car l) 时，直接舍弃 (car l) 只返回 (cdr l)，这实际就是 rember 的功能，即删除第一个匹配的元素。注意 ((insert-g seqrem) #f a l))) 中的 #f 可以替换成任意对象：
(define yyy
(lambda (a l)
((insert-g seqrem) "无人喝彩" a l)))
(yyy
'sausage
'(pizza with sausage and bacon))
'(pizza with and bacon)
The ninth commandment
Abstract common patterns with a new function.
The ninth commandment
对计算器的实现函数进行抽象
第六章介绍计算器的时候，引入了 value 函数，如下
(define value
(lambda (nexp)
(cond
((atom? nexp) nexp)
((eq? (car (cdr nexp)) '+)
(+ (value (car nexp))
(value (car (cdr (cdr nexp))))))
((eq? (car (cdr nexp)) 'x)
(* (value (car nexp))
(value (car (cdr (cdr nexp))))))
((eq? (car (cdr nexp)) '^)
(expt (value (car nexp))
(value (car (cdr (cdr nexp))))))
(else #f))))
对 value 进行抽象，从哪里开始？因为 value 的判断分支都是在确定形如 (a + b) 的公式中间的运算符是什么，因此这实际是一个查表的过程（有时称为 dispatching），于是把查询的 key 和 value 专门抽出来比较合理。
(define atom-to-function
(lambda (atom)
(cond
((eq? atom '+) +)
((eq? atom 'x) *)
((eq? atom '^) expt)
(else #f))))
(atom-to-function (operator '(+ 5 3)))
#<procedure:+>
把对表达式对象的 getter 也抽象成函数（第六章做过）
(define operator
(lambda (aexp)
(car aexp)))
(define 1st-sub-exp
(lambda (aexp)
(car (cdr aexp))))
(define 2nd-sub-exp
(lambda (aexp)
(car (cdr (cdr aexp)))))
value 就可以重写成：
(define value
(lambda (nexp)
(cond
((atom? nexp) nexp)
(else
((atom-to-function (operator nexp))
(value (1st-sub-exp nexp))
(value (2nd-sub-exp nexp)))))))
(value '(+ 1 (^ 3 4)))
82
吃掉肉（数据），留下骨头（计算结构）
第三章介绍的删除 list 中出现某个元素的函数如下：
(define multirember
(lambda (a lat)
(cond
((null? lat) '())
((eq? (car lat) a)
(multirember a (cdr lat)))
(else
(cons (car lat) (multirember a (cdr lat)))))))
采用前几节中同样的套路，把 eq? 函数抽取成参数：
(define multirember-f
(lambda (test?)
(lambda (a lat)
(cond
((null? lat) '())
((test? (car lat) a)
((multirember-f test?) a (cdr lat)))
(else
(cons (car lat) ((multirember-f test?) a (cdr lat))))))))
((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna))
curry 化：
(define multirember-eq? (multirember-f eq?))
到目前为止，已经对 rember, insertL, insertR, multirember, subset 都做了一样的事情：把 eq? 部分抽出来作为一个通用的参数 test?.
还可以对 test? 做更多事情，观察 multirember-f 中递归的两个分支：
((test? (car lat) a) ((multirember-f test?) a (cdr lat)))
(else (cons (car lat) ((multirember-f test?) a (cdr lat))))
以上代码中真正操作数据 a 的部分就是比较了 (car lat) 和 a,
其他都是自然递归的代码了，鉴于闭包可以作为一个盒子，例如本章第一节中 eq?-c 把沙拉吃进去，变成了 eq?-salad
(define eq?-c
(lambda (a)
(lambda (x)
(eq? a x))))
(define eq?-salad (eq?-c 'salad))
因此也可以让 test? 把 a 吃进去，变成类似 test?-a 的函数（盒子）， multiremberT 就在做这种事：
(define multiremberT
(lambda (test? lat)
(cond
((null? lat) '())
((test? (car lat))
(multiremberT test? (cdr lat)))
(else
(cons (car lat)
(multiremberT test? (cdr lat)))))))
以下是把 tuna 吃进闭包（盒子），再传给 multiremberT 执行：
(define eq?-tuna
(eq?-c 'tuna))
(multiremberT
eq?-tuna
'(shrimp salad tuna salad and tuna))
'(shrimp salad salad and)
这样做的好处是什么？
个人理解是使得递归主体代码形式更简单了，由于把额外的参数 a 交接给了 test? 来处理，原本主函数承载的数据处理逻辑也转移到 test? 里。
当前的 multiremberT 内部只负责对问题进行分解，具体来说，就是把 list 拆分成 (car lat) 和 (cdr lat) ，这工作完全是为自然递归而服务的，因此该函数更加抽象和通用，更像一个纯计算结构。这种思路在下一章构造 Y 时发挥到极致。
Continuaion: 蓄力前行，厚积薄发
前文说到，函数可以看作是一个能装数据的盒子（闭包），例如 eq-c? 可以装沙拉（salad），也可以装金枪鱼（tuna）。
因此 eq-c? 应该是个食材分拣装置，或者是一个寻味美食家。
本节的例子，充分发挥（压榨）了函数作为盒子的能力，几乎要把闭包当作货运列车，首先我用一个例子展现这种能力：
以下是函数 f 的执行的表达式：
(f '())
由于没有交代 f 是什么，一种简单的猜想是， f 可能是 (lambda (x) x), 因此代码变成了：
((lambda (x) x) '())
'()
然而 f 也可以更复杂，就像 eq-c? 可以喂入 salad 和 tuna 一样， f 也可以是一个带有其他对象的闭包，比如以下是一个投食函数，只要把函数传给它，它就会给函数吃一节火车：
(define concat-车厢
(lambda (f id)
(lambda (x) (f (cons id (cons '车厢 x))))))
以上 concat-车厢 函数可以接受一个函数和一个 id(为了区分顺序)，然后返回一个新的函数，新函数中也是执行原始的 f, 不过对传给 f 的参数进行了加工。
于是，可以把 f 最原始的 (lambda (x) x) 形态传给 concat-车厢 得到一个增强版的 f, 它继续执行 (f '())
不过输出的结果是带有车厢的：
((concat-车厢 (lambda (x) x) 1) '())
'(1 车厢)
以上代码中 (lambda (x) x)) 是原始的 f, (concat-车厢 (lambda (x) x)) 是被 concat-车厢增强（装饰）过的 f
可以继续装饰下去，例如以下对 f 增强 5 次：
(define f (lambda (x) x))
(define f (concat-车厢 f 1))
(define f (concat-车厢 f 2))
(define f (concat-车厢 f 3))
(define f (concat-车厢 f 4))
(define f (concat-车厢 f 5))
(f '())
'(1 车厢 2 车厢 3 车厢 4 车厢 5 车厢)
于是原本只能输出空 list 的 f 变成了输出一列火车，f 相当于一个收集数据的结构，只不过它是函数形式，被称为 continuation.
continuation 的一个特点是，它每次都在吸收新对象，不到递归终点的最后一刻从不显现出来，正如以上代码中，对 f 包装的过程中非常平静，但在执行 (f '()) 时，之前积蓄的能量被一并释放。
如果 f 有多个参数，那么可以一次搜集多种不同的数据，以下是书本里的例子，这是一种被称作 Continuation Passing Style (CPS,击鼓传花) 编程风格。
(define multiremember&co
(lambda (a lat col)
(cond
((null? lat)
(col '() '()))
((eq? (car lat) a)
(multiremember&co a (cdr lat)
(lambda (newlat seen)
(col newlat (cons (car lat) seen)))))
(else
(multiremember&co a (cdr lat)
(lambda (newlat seen)
(col (cons (car lat) newlat) seen)))))))
其中的 col 函数有两个参数, 因此递归时在攒两组数据, 第一组搜集的是 lat 中不等于 a 的元素，第二组搜集的是 lat 中等于 a 的元素
在递归终点，col 才真增调用，做最后的数据处理，以下例子中，由于 lat 中包括 tuna, 第二组数据搜集结果就是 '(tuna), 因此返回 #f
(define a-friend
(lambda (x y)
(null? y)))
(multiremember&co
'tuna
'(strawberries tuna and swordfish)
a-friend)
#f
以下例子中，最后 a-friend 执行时 x y 参数都是空，因此返回 True
(multiremember&co
'tuna
'()
a-friend)
#t
new-friend 强行给 a-friend 的第二个参数加上新朋友 tuna, 这意味着 multiremember&co 永远返回 #f:
(define new-friend
(lambda (newlat seen)
(a-friend newlat (cons 'tuna seen))))
(multiremember&co
'tuna
'(strawberries tuna and swordfish)
new-friend)
#f
(multiremember&co
'tuna
'()
new-friend)
#f
(multiremember&co
'tuna
'(tuna)
new-friend)
#f
last-friend 统计 lat 中不等于 a 的元素个数
(define last-friend
(lambda (x y)
(length x)))
(multiremember&co
'tuna
'(strawberries tuna and swordfish)
last-friend)
3
(multiremember&co
'tuna
'(tuna)
last-friend)
0
The tenth commandment
Build functions to collect more than one value at a time.
The tenth commandment
更多 CPS 练习：理解 continuation 参数
以下函数在 oldL 左侧插入 new, 并在 oldR 右侧插入 new
(define multiinsertLR
(lambda (new oldL oldR lat)
(cond
((null? lat) '())
((eq? (car lat) oldL)
(cons new
(cons oldL
(multiinsertLR new oldL oldR
(cdr lat)))))
((eq? (car lat) oldR)
(cons oldR
(cons new
(multiinsertLR new oldL oldR
(cdr lat)))))
(else
(cons
(car lat)
(multiinsertLR new oldL oldR
(cdr lat)))))))
(multiinsertLR
'x
'a
'b
'(a o a o b o b b a b o))
'(x a o x a o b x o b x b x x a b x o)
如何修改成 CPS 形式？首先把递归部分 (cons typical-element (natural-recursion)) 全部写成纯递归调用(尾递归形式), 那么整个公式就变成纯递归形式了，操作数据部分在哪里？就像 eq-c? 吃掉 salad 一样，数据被放到了一个新的函数中，根据搜集器的功能，对搜集器的不同参数做不同的累积操作（如果是累积 list 就用 cons, 如果是累积数字，就用加法），每个分支只搜集当前分支需要的数据。
(define multiinsertLR&co
(lambda (new oldL oldR lat col)
(cond
((null? lat)
(col '() 0 0))
((eq? (car lat) oldL)
(multiinsertLR&co new oldL oldR (cdr lat)
(lambda (newlat L R)
(col (cons new (cons oldL newlat))
(+ 1 L) R))))
((eq? (car lat) oldR)
(multiinsertLR&co new oldL oldR (cdr lat)
(lambda (newlat L R)
(col (cons oldR (cons new newlat))
L (+ 1 R)))))
(else
(multiinsertLR&co new oldL oldR (cdr lat)
(lambda (newlat L R)
(col (cons (car lat) newlat)
L R)))))))
取以上代码第一个递归分支里的 continuation, 我的疑问是，但这个 continuation 被调用的时候，传递给参数 (newlat L R) 的值分别是什么？
(lambda (newlat L R)
(col (cons new (cons oldL newlat))
(+ 1 L) R))
最明确的是，如果这个函数直接进入到递归终点，也就是 (cdr lat) 为空的时候，那么传入的分别是 '(), 0, 0
而如果 (cdr lat) 是最后一个元素，并且该元素等于 oldL，那么传给 (newlat L R) 的就应该是 ((new oldL), 1, 0), 这实际是从 (cdr lat) 搜集到的数据，这个数据可以看作是当前程序运行的状态。
因此我自己新加了一条原则：
每个 continuation 的形参最终会被 natural recursion 部分的子结构状态所替换
– The missing Commandment
这个原则让我能更好地理解下一节二维递归下的 CPS 代码
现在，可以单独定义不同的搜集器：
(define col1
(lambda (lat L R)
lat))
(define col2
(lambda (lat L R)
L))
(define col3
(lambda (lat L R)
R))
把搜集器作为参数传进去，就能得到不同结果
(multiinsertLR&co
'salty
'fish
'chips
'(chips and fish or fish and chips)
col1)
'(chips salty and salty fish or salty fish and chips salty)
(multiinsertLR&co
'salty
'fish
'chips
'(chips and fish or fish and chips)
col2)
2
(multiinsertLR&co
'salty
'fish
'chips
'(chips and fish or fish and chips)
col3)
2
树递归（二维递归）的 CPS 场景
对于带 star 的二维递归的函数，
以下是搜集嵌套的 list of number 中所有偶数的函数
(define evens-only*
(lambda (l)
(cond
((null? l) '())
((atom? (car l))
(cond
((even? (car l))
(cons (car l)
(evens-only* (cdr l))))
(else
(evens-only* (cdr l)))))
(else
(cons (evens-only* (car l))
(evens-only* (cdr l)))))))
(evens-only*
'((9 1 2 8) 3 10 ((9 9) 7 6) 2))
'((2 8) 10 (() 6) 2)
写成 CPS 形式，搜集三组数据，第一组是所有的偶数的 list, ，第二组是所有偶数的乘积，第三组是所有奇数的和，如果理解了前文的 CPS, 这里可以停下来尝试自己实现：
- 首先确定终止时执行 col 的三个参数，由于第二个是求乘积，因此应该用 1, 所以它应该是
(col '() 1 0) 接着把 evens-only* 的自然递归部分全部改成调用
evens-only*&co，并且第一个参数肯定是 l 的缩小版：(cdr l), 第二个参数是一个带三个参数的 lambda 函数，先填补上形式，之后填写内容：(define evens-only*&co (lambda (l col) (cond ((null? l) (col '() 1 0)) ((atom? (car l)) (cond ((even? (car l)) (evens-only*&co (cdr l) (lambda (newl prod sum) something1))) (else (evens-only*&co (cdr l) (lambda (newl prod sum) something2))))) (else (evens-only*&co something3)
注意这里树递归部分由于要对 (car l) 和 (cdr l) 都进行递归，因此参数部分细节不是 (cdr l), 还要继续分析。
先考虑其中的 something1, 此分支表明 (car l) 是偶数，也就意味着要把数据搜集到前两组中，因此这部分应该是：
(lambda (newl prod sum) (col (cons (car l) new1) (* (car l) prod) sum))something2 和 something1 对偶，发现 (car l) 是奇数，因此只对 col 的第三个参数有贡献
(lambda (newl prod sum) (col new1 prod (+ (car l) sum)))someting3 中涉及两组递归，是最有趣的部分，我们要想的是，由于当前看到的 (car l) 是一个 list, 因此要在 (car l) 上递归，代码可能要写成如下形式：
(evens-only*&co (car l) (lambda (newl prod sum) something3.1))注意以上还是
(evens-only*&co l col)的形式，只不过作用在 (car l) 上，并且期望 col 是一个已经搜集了 (cdr l) 数据的函数， 因此 something3.1 部分应该还是(evens-only*&co l col)形式，只不过 l 替换成了 (cdr l).(evens-only*&co (car l) (lambda (newl prod sum) (evens-only*&co (cdr l) (lambda (new2 prod2 sum2) something3.2))))填充 something3.2 根据上一节总结的
The missing Commandment， (newl prod sum) 最终会被分析完 (car l) 后的状态信息所取代，而 (new2 prod2 sum2) 会被分析完 (cdr l) 后的状态所取代，因此在 something3.2 中要做的，就是把这两部分信息继续汇总起来，再传给 col！ 如下(evens-only*&co (car l) (lambda (newl prod sum) (evens-only*&co (cdr l) (lambda (new2 prod2 sum2) (col (cons new1 new2) (* (car l) prod) (+ (car l) sum)) ))))
最终结果是（原文中代码）：
(define evens-only*&co
(lambda (l col)
(cond
((null? l)
(col '() 1 0))
((atom? (car l))
(cond
((even? (car l))
(evens-only*&co
(cdr l)
(lambda (newl p s)
(col (cons (car l) newl) (* (car l) p) s))))
(else
(evens-only*&co
(cdr l)
(lambda (newl p s)
(col newl p (+ (car l) s)))))))
(else
(evens-only*&co
(car l)
(lambda (al ap as)
(evens-only*&co (cdr l)
(lambda (dl dp ds)
(col (cons al dl)
(* ap dp)
(+ as ds))))))))))
取出所有的偶数
(define evens-friend
(lambda (e p s)
e))
(evens-only*&co
'((9 1 2 8) 3 10 ((9 9) 7 6) 2)
evens-friend)
'((2 8) 10 (() 6) 2)
取出所有偶数的乘积
(define evens-product-friend
(lambda (e p s)
p))
(evens-only*&co
'((9 1 2 8) 3 10 ((9 9) 7 6) 2)
evens-product-friend)
1920
所有奇数的和
(define evens-sum-friend
(lambda (e p s)
s))
(evens-only*&co
'((9 1 2 8) 3 10 ((9 9) 7 6) 2)
evens-sum-friend)
38
返回所有信息：
(define the-last-friend
(lambda (e p s)
(cons s (cons p e))))
(evens-only*&co
'((9 1 2 8) 3 10 ((9 9) 7 6) 2)
the-last-friend)
'(38 1920 (2 8) 10 (() 6) 2)
9 … and Again, and Again, and Again, …
本章探讨如何分析函数是否陷入死循环，介绍了停机问题和 Y 算子
人眼识别递归状态：偏函数的引入
之前讨论的都是自然递归，也就是每次递归时，问题规模都变小了，计算总是朝着停止的方向前进，本节则引出了非自然递归的情况，这会导致程序无法停止。从而引出了一个问题：是否可以写一个函数来检查另外的函数执行后是否会停止，但用一种反证法证明了这样的函数不存在。
首先请出第四章的 pick 函数，返回 lat 里第 n 个元素：
(define pick
(lambda (n lat)
(cond
((zero? (sub1 n)) (car lat))
(else
(pick (sub1 n) (cdr lat))))))
然后引入：
(define keep-looking
(lambda (a sorn lat)
(cond
((number? sorn)
(keep-looking a (pick sorn lat) lat))
(else (eq? sorn a )))))
(keep-looking 1 'a '())
#f
个人感觉这是全书中最让人感到不适的例子，因为太多槽点了。
首先分析它的功能， keep-looking 是一个把数组值作为索引不断在原数组上进行查找的函数，直到找到一个不是 number 的对象，才会把这个对象与 a 进行比较。因此该函数的停止条件是 sorn 不是数字的时候，那么它的自然递归部分应该保证 sorn 是数字的概率要更接近 0.
然而，书本解释是它不是自然递归的原因是因为没有在 lat 的子序列上递归。在 (cdr lat) 上递归最终肯定会递归到空 list, 空 list 中取不到数字，所以似乎可以认为这是自然递归。不过问题在于即使在 (cdr lat) 上递归，当 sorn 是 number 且 lat 是 '() 的时候不会正常停止，而是异常（虽然会导致停机，但也不自然），如下：
(define keep-looking2
(lambda (a sorn lat)
(cond
((number? sorn)
(keep-looking a (pick sorn lat) (cdr lat)))
(else (eq? sorn a )))))
(keep-looking2 'a 1 '(1 2 3 4 5))
pick: undefined; cannot reference an identifier before its definition in module: top-level context...: body of top-level eval:2:2: keep-looking2
不过作者只是想介绍一种在某些输入不停机的函数，因此继续容忍这个例子。
looking 则是从数组第一个元素开始找起
(define looking
(lambda (a lat)
(keep-looking a (pick 1 lat) lat)))
(looking 'caviar '(6 2 4 caviar 5 7 3))
#t
(looking 'caviar '(6 2 grits caviar 5 7 3))
#f
如果 lat 都是数字, looking 就会陷入无限递归，因此该函数的某个输入没有对应的输出。
这种函数称为偏函数，在第七章关系和函数中，介绍了 fullfun? 函数, 它是对 list of pairs 而言的，也就是一一映射函数（存在反函数的函数），而这里的偏函数是针对 scheme 函数而言的，要注意区分。
不过个人觉得，他们之间还是有一定内在联系，于是询问 GPT
程序中某个函数是 partial 的，表明它可能有些输入是没有输出的对吗？也就是可能不停机，这与数学中的全函数有什么关系吗
在计算机科学中，一个函数被称为"partial"（部分的），如果它对某些输入没有定义输出。这可能是因为函数在某些输入上没有停机，或者因为函数在某些输入上抛出了异常。这与数学中的"total"（全）函数相对，total函数对其所有可能的输入都有定义输出。
在计算机科学中，我们通常关心的是函数是否是"全"的，因为我们希望我们的程序对所有输入都能给出结果。然而，实际上，许多函数都是"部分"的，因为它们可能在某些输入上没有定义输出。例如，如果我们有一个函数，它的任务是找到一个列表中的最大元素，那么这个函数就是部分的，因为它对空列表没有定义输出。
总的来说，"部分函数"和"全函数"的概念是用来描述函数对其输入的完整性的，而"一一映射"是用来描述函数的单射性质的。这两个概念在数学和计算机科学中都有广泛的应用。
可以看到，第 7 章里的 fullfun? 还是不要翻译成全函数为好，就叫一一映射函数，它不等于 total 函数，
这样的话，"偏函数" 理解成 "部分函数" 或许更贴切：
在数学中，"全函数"（total function）和"一一映射"（one-to-one mapping，也称为"单射"）是两个不同的概念。全函数是指对所有输入都有定义输出的函数，而一一映射是指不同的输入对应不同的输出的函数。也就是说，一一映射保证了函数的反函数存在。
个人补充：
如果把空 list 看作是未定义的话（有某个定义域里的值需要进入无限大的空间去寻找与它匹配的值，导致无限循环），以下 list of pair 可以看作是偏函数
((1 2) (3 4) (5 6) (7 ()))
以上关系表明，在输入为 7 的时候，找不到要给具体的对应值，因此机器可能不停机。
一个无限循环的纯 paritial 函数
(define eternity
(lambda (x)
(eternity x)))
人眼识别递归状态：函数偏不偏？
上一节的 keep-looking 和 eternity 是比较容易识别是否会停机的，本节介绍一些更微妙的案例，
这部分需要识别出递归的
先引入一些前文提到的辅助函数，用来操作 pair:
(define first
(lambda (p)
(car p)))
(define second
(lambda (p)
(car (cdr p))))
(define build
(lambda (s1 s2)
(cons s1 (cons s2 '()))))
(define a-pair?
(lambda (x)
(cond
((atom? x) #f)
((null? x) #f)
((null? (cdr x)) #f)
((null? (cdr (cdr x))) #t)
(else #f))))
将 pair 中括号左移：
(define shift
(lambda (pair)
(build (first (first pair))
(build (second (first pair))
(second pair)))))
(shift '((a b) c))
'(a (b c))
(shift '((a b) (c d)))
'(a (b (c d)))
接着问，以下 align 函数是不是 partial?
(define align
(lambda (pora)
(cond
((atom? pora) pora)
((a-pair? (first pora))
(align (shift pora))) ;; 递归分支 1
(else
(build (first pora)
(align (second pora))))))) ;; 递归分支 2
(align '())
car: contract violation expected: pair? given: '() context...: eval:2:2: body of top-level
(align '((a b) (c (d e))))
'(a (b (c (d e))))
align 递归停止的条件为 (atom? pora) ， 因此如果要停机，之后两个递归分支中 align 的参数是 atom 类型的概率应该越来越大，直到变成 1 。分析两个递归分支中的情况：
当
pora第一元素是 pair 的时候，进入递归分支 1，会对 pora 做一次 shift 后继续调用align, 该操作不会让 pora 变成 atom, 因为根据shift的定义，shift 返回的仍然是 pair. 不过好消息是，shift 会拆解 pora 的第一个元素，因此它使得(first pora)会逐渐趋向于 atom, 因此递归更多都会走向第二个分支。注意： 如果 pora 结构里存在自引用，例如类似以下形式的例子（这个例子跑不通，只是示意），可能会无限循环，因为每次 shift 之后第一个元素是 pora 自身，而 pora 永远是 pair。
(define pora `((,pora, a) b))- 在第二个递归分支中，pora 的第 1 个元素已经不是 pair 了，此时会对 (second pora) 进行递归，这等价于 (cdr pora), 因此看上去就是自然递归。不过还是可以继续问： (second pora) 操作是否会让 pora 更接近 atom? ，由于 second 是一种分解行为，因此一般情况下总会分解到 atom. （同样要排除以上提到的自引用的情况）
- 由此可知，如果没有自引用结构，
align是会停机的，它不是偏函数。
个人感觉,分析递归是否停止的过程需要一种 “特征提取”的能力，分析递归函数中的参数的特征是否在逐渐趋近某个值，类似机器学习里也有特征提取函数,例如 SVM 中的核函数。
找 GPT 来点评以上的类比：
分析递归是否停止的过程需要一种 “特征提取”的能力，分析递归函数中的参数的特征是否在逐渐趋近某个值，类似机器学习里也有特征提取函数,例如 SVM 中的核函数。 这种类比合理吗
这个类比有一定的合理性，但也有一些关键的区别需要注意。
在分析递归函数是否会停止的过程中，确实需要观察和理解函数参数的变化。这个过程可能涉及到识别参数的“特征”，例如，参数是否在逐渐趋近某个值，或者参数是否在每次递归调用中按照某种模式变化。这个过程在某种程度上可以看作是一种“特征提取”。
然而，这与机器学习中的特征提取有一些关键的区别。在机器学习中，特征提取通常涉及到从原始数据中提取有用的信息，以帮助模型进行预测。这个过程通常需要大量的数据，并且依赖于统计和数据挖掘技术。而在分析递归函数的过程中，我们通常只需要理解函数的逻辑和结构，而不需要大量的数据或复杂的统计技术。
此外，虽然理解递归函数的行为在某种程度上可能类似于机器学习（因为它们都涉及到理解输入和输出之间的关系），但这两者在许多重要方面是不同的。例如，机器学习模型通常是通过从大量的训练数据中学习来建立输入和输出之间的关系，而递归函数的行为则是由其定义直接决定的。
总的来说，虽然这个类比在某些方面有一定的合理性，但也需要注意这两个过程之间的关键区别。
以下是原书中给出的对 align 的输入参数 pora 进行"特征提取"的函数，第一个是统计 pora 里 atom 的个数。
那么问题就是？ 是否每次递归后 pora 中 atom 的数量在变化？
(define length*
(lambda (pora)
(cond
((atom? pora) 1)
(else
(+ (length* (first pora))
(length* (second pora)))))))
原书认为 length* 不是一个很好的 align 参数的特征函数，因为 (shift pora) 不会改变 pora 中 atom 的个数。这是合理的，该特征在递归分支 1 中是不变的，因此把 length* 作为依据很可能得到 align 是偏函数的结论。（不过这个特征对于分支 2 是有效的，但我们应该考虑所有的分支）
改进后的特征函数是, 把更多权重放在 pora 的第一个参数上，这里比例是 2:1
(define weight*
(lambda (pora)
(cond
((atom? pora) 1)
(else
(+ (* (weight* (first pora)) 2)
(weight* (second pora)))))))
(weight* '((a b) c))
7
(weight* '(a (b c)))
5
weight* 是一个更好的特征函数，因为无论对于递归分支 1 中的 (shift pora) ，还是递归分支 2 中的 (second pora), 它们的 weight 都在减小，而递归中止条件是 weight = 1 .
有了以上的分析思路，接着看一个新的例子： shuffle, 该函数把 align 中的 shift 改成了 revpair
如果 pora 是一个 pair, 并且两个元素都是 pair, 那么会陷入不断的相互交换的递归中，永远跳不出第一个递归分支
(define revpair
(lambda (p)
(build (second p) (first p))))
(define shuffle
(lambda (pora)
(cond
((atom? pora) pora)
((a-pair? (first pora))
(shuffle (revpair pora)))
(else
(build (first pora)
(shuffle (second pora)))))))
(shuffle '(a (b c)))
'(a (b c))
(shuffle '(a b))
'(a b)
无限循环，栈溢出
(shuffle '((a b) (c d)))
3n+1 猜想：你不知道的事
本节引入 3n+1 猜想的函数实现，说明判断某函数是否是偏函数是一个很难的问题。 本猜想有非常多的名字，比如 Collatz 猜想，奇偶归一猜想，冰雹猜想等等，参见 考拉兹猜想 - 维基百科，自由的百科全书
(define one?
(lambda (n) (= n 1)))
(define C ; Collatz conjecture
(lambda (n)
(cond
((one? n) 1)
(else
(cond
((even? n) (C (/ n 2)))
(else
(C (add1 (* 3 n)))))))))
函数第一个递归分支中，会不断减小 n 的值，因此，如果输入 n 是 2 的幂，那么会以指数衰减，坠向地面：
(C (expt 2 20))
1
但由于 (add1 (* 3 n)) 递归分支是使得自然数变大，因此违背了自然数的自然递归原则，带来了无尽的复杂性，据说至今还不知道是否存在一个正整数会导致函数 C 陷入无限循环。
多的是，你不知道的事。
Ackermann 函数: 猫中的猫头鹰
本节介绍 Ackermann 函数，如下
(define A
(lambda (n m)
(cond
((zero? n) (add1 m))
((zero? m) (A (sub1 n) 1))
(else
(A (sub1 n)
(A n (sub1 m)))))))
(A 1 0)
2
(A 1 1)
3
m=1 时，比较好算：
(A 1 100)
102
(A 2 2)
7
Ackermann 并不是未解之谜，它是全函数，必然会停机，将函数写成一下形式更容易理解
A(m, n) = n + 1 if m = 0 A(m - 1, 1) if m > 0 and n = 0 A(m - 1, A(m, n - 1)) if m > 0 and n > 0
- 首先，停止的条件是的 m=0
- 在 n 为 0 的时候，m 会减小 1, 更靠近结束条件，不过代价是 n 会变成 1. n = 1 的情况下，如果 m 不是 0 ，则会进入第二个递归分支
A(m - 1, A(m, n - 1))分支中， m-1 是朝着停止条件进行，然而第二个参数是一个新的递归的结果A(m, n - 1)对比一般的自然递归，比如阶乘，它的定义是 fact(n)= n*fact(n-1), 递归的过程中，调用栈会不断等待 fact(n-1), 直到 n-1 是 1 时则进行回溯。 但 A 函数执行展开后部分是 A(m - 1, A(m, A(m, A(m，n-3)))), 函数第二个参数不断被展开，而每计算完一层内部的递归，返回一个（很大）的整数，又要进行更多次递归，这是一种高阶递归的模式。
以下是与 GPT 的关于 Ackermann 以及原书中作者引用的 Carroll 的诗歌的讨论（可能有错误，但没有 GPT 我感觉永远也 get 不到书里埋的梗，有了 GPT 至少能提供某些启发）：
你在解释 Ackermann 函数时说道： 更具体地说，原始递归函数在定义时，递归的深度是固定的，而Ackermann函数的递归深度则取决于函数的输入。这就是为什么Ackermann函数不是原始递归的。
但这句话似乎有问题，因为任何递归函数，递归的深度也和输入 n 有关，比如用递归计算第 n 个 fibnacci 数，n 越大递归显然越深
对不起，我可能没有解释清楚。你是对的，任何递归函数的递归深度都可能依赖于输入。然而，原始递归函数和Ackermann函数的主要区别在于递归的“形状”或者说“模式”。
在原始递归函数中，递归的模式是预先确定的。也就是说，我们可以在不知道具体输入的情况下，就能确定函数在递归时会如何减小其参数。例如，对于计算阶乘的函数，我们知道每次递归调用都会将输入减小1。对于计算Fibonacci数列的函数，我们知道每次递归调用都会将输入减小1或2。
然而，对于Ackermann函数，递归的模式取决于函数的输入。在Ackermann函数的定义中，函数在递归时会如何减小其参数并不是预先确定的，而是取决于输入的值。这就是为什么Ackermann函数不是原始递归的。
But answer came there none-
And this was scarcely odd, because
They 'd eaten every one.
The Walrus and The Carpenter
-Lewis Carroll
这里想表达什么
这是来自Lewis Carroll的诗歌"The Walrus and The Carpenter"的一段。在这首诗中，海象和木匠诱骗一群蠔（一种贝壳类动物）跟随他们走进海滩，然后他们把所有的蠔都吃掉了。
在你引用的这段诗中，"But answer came there none-"意味着没有回答，"And this was scarcely odd, because They 'd eaten every one."解释了为什么没有回答——因为海象和木匠已经把所有的蠔都吃掉了。
这首诗常常被解读为关于欺骗和背叛的寓言。海象和木匠的行为被视为对信任的滥用，他们利用蠔的天真和信任，然后背叛了它们。
这句话是否影射了 Ackermann 函数看上去像原始递归，但实际不是，背叛了原始递归
虽然这是一个有趣的解读，但Lewis Carroll的诗歌"The Walrus and The Carpenter"和Ackermann函数之间并没有直接的联系。这首诗是关于欺骗和背叛的，而Ackermann函数是一个在计算理论中用来展示计算复杂性的例子。
然而，如果你愿意，你可以将这首诗的主题应用到Ackermann函数的讨论中。就像海象和木匠看起来像是蠔的朋友，但最后背叛了它们，Ackermann函数在表面上看起来像是一个原始递归函数，但实际上它的行为和原始递归函数有很大的不同。这是因为Ackermann函数的计算复杂性随着输入的增大而迅速增加，而原始递归函数的计算复杂性通常是可预测的。
然而，这种解读应当谨慎对待，因为它可能会引起误解。Ackermann函数并没有"背叛"原始递归函数，它只是一个用来展示计算复杂性的工具。
停机问题：此事古难全
前几节里一直是智人在肉眼识别函数是否停止，多分析了几次之后，可能就开始思考是否能够让机器来判断了。
于是假设有一个能够判断任何程序是否停机的函数 will-stop?, 首先只考虑 will-stop? 识别某个函数 f 是否在输入为空的时候停机情况（从简单入手），如果能解决这个，再考虑更多参数的情况。
根据对 will-stop? 的期望，它要是一个全函数才行，这样人类才有可能等到结果（别忘了还有 ackermann 这样的潜伏者），那么可以构造如下函数：
(define last-try
(lambda (x)
;; 注意只有 will-stop? 自己一定会停机这里 and 才有意义
(and (will-stop? last-try)
(eternity x))))
把 last-try 交给 will-stop? 后，如果返回 #t, 说明 last-try 停机，也就是说明 (and (will-stop? last-try) 这里返回 #f. 反过来如果 (will-stop? last-try) 返回 #f 说明 last-try 内部会执行到
(eternity x), 因此 (will-stop? last-try) 返回 #t.
will-stop? 不可能作为全函数形式存在，因此它可以退一步成为一个偏函数，最简单的实现就是：
(define will-stop?
(lambda (f)
(or (f) #t)))
然而该函数的意思就是重新把皮球踢回给智人，要人自己去执行并观察 f 是否停止。所以说，“此事古难全，但愿人长久”， will-stop? 自古就不是全函数，但只要你能永生，等足够久，总会知道 f 是否停机，❄️。
Y 算子： 能验证但难理解
原书中从停机问题到 Y 算子的过渡很快，大致就以下的几轮对话：
It makes will-stop? the first function that we can describe precisely but cannot define in our language.
What is (define . . . )
This is an interesting question . We just saw that (define . . . ) doesn't work for will-stop?.
So what are recursive definitions?
接着作者就开始讨论匿名函数递归了，我无法完全理解这是怎么转换过来的，或者总觉得有点牵强（当然书本本身就是非正式对话风格，也不保证话题切换必须要有很充分的理由）
我自己填上的理由是：
停机问题证明了存在可以清晰地描述功能但无法实现的函数（也许产品经理也比较擅长这类证明），而人类语言中"描述"和 scheme 中的 define 是比较相似的，因此考虑，如果没有 define 的能力，还会出现这个问题吗？ Y 算子证明，即便隐姓埋名，该来的总还是会来。
这条解释比较牵强的原因在于，没有 define 关键词并不代表程序语言无法进行定义或命名，因为 scheme 里函数的参数就已经自带了很强的"命名"的能力（在第 10 章会有更清楚的认识），缺少 define 只是少了命名全局的变量的能力而已， Y 算子也就是利用函数参数可以自指（自复制）的特性而克服了最顶层命名能力缺失带来的困难，这引出了下一条理由。
- 停机问题的证明中使用了自指（让停机函数去判断另一个调用了停机函数的函数是否停机），而 Y 中也用了类似技巧。
Y 算子的推导类似数学里对公式的化简，比如化简以下公式（找 GPT 给出后再稍作修改的） \[ 2x^3y + 4x^2y^2 - 6x^2y \]
提取出： \( 2x^2y \) 得到： \[ x(2x^2y) + 2y(2x^{2}y) -3(2x^{2}y) = (2x^{2}y)(x+2y-3) \]
当然 Y 比这个复杂得多，但它总体是一种不断对抽取模式的过程，以下更多是列出原书中的关键代码， 因为这个推导十分跳跃，除了靠记忆和运气，我几乎无法很顺畅地复现。
以下称为 length0 函数，它只能计算长度为 0 的 list 的长度，当输入 l 长度大于 0, 就会陷入无限循环
(lambda (l)
(cond
((null? l) 0)
(else
(add1 (eternity (cdr l))))))
#<procedure>
计算长度小于等于 1 的 list 的长度的函数，length<=1
(lambda (l)
(cond
((null? l) 0)
(else
(add1
((lambda(l)
(cond
((null? l) 0)
(else
(add1 (eternity (cdr l))))))
(cdr l))))))
当然可以继续写下去，只要每次把其中的 eternity 替换成 length0, 因此可以做第一个提取公因式，名字就叫做 MK-LENGTH （用大写字母表示在程序外部给程序取的名字）：
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
把 eternity 传给 MK-LENGTH ，得到就是新的 length0：
((lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
eternity)
而把得到的 length0 继续给 MK-LENGTH , 就会得到 lenght<=1:
((lambda (f)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (f (cdr l)))))))
((lambda (g)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (g (cdr l)))))))
eternity))
以上实际是 (MK-LENGTH (MK-LENGTH eternity)) 的形式，总的来说就是不断把 MK-LENGTH 的参数替换成上一次 MK-LENGTH 的结果，而后得到一个新的函数，它能计算更长的列表的长度，因此 MK-LENGTH 自己又变成公因式了，可以提取出来：
(lambda (mk-length)
(mk-length eternity))
把 MK-LENGTH 传给以上函数就得到 length0：
(lambda (mk-length)
(mk-length eternity) MK-LENGTH)
而 lenght<=2 是：
(lambda (mk-length)
(mk-length (mk-length (mk-length eternity))) MK-LENGTH)
而 lenght<=3 是：
(lambda (mk-length)
(mk-length (mk-length (mk-length (mk-length eternity)))) MK-LENGTH)
依此写下去。。。
由于 eternity 在实际中是不会被计算到的，它只是个函数，因此可以替换成任意函数
于是：
(lambda (mk-length)
(mk-length eternity))
可以改为
(lambda (mk-length)
(mk-length mk-length))
（这一步不太会想到，很跳跃）
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(lambda (l)
(cond
((null? l) 0)
(else
(add1
((mk-length eternity) (cdr l))))))))
#<procedure>
更跳跃的是把 MK-LENGTH 替换成以下形式，这时候只要一步一步把代码带进去，发现就可以进行递归了（不过无法理解）：
(((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(lambda (l)
(cond
((null? l) 0)
(else
(add1
((mk-length mk-length) (cdr l))))))))
'(1 2 3 4 5))
5
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
((lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else
(add1 (length (cdr l)))))))
(lambda (x)
((mk-length mk-length) x)))))
#<procedure>
((lambda (le)
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(le (lambda (x)
((mk-length mk-length) x))))))
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l))))))))
#<procedure>
(lambda (le)
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(le (lambda (x)
((mk-length mk-length) x))))))
#<procedure>
(define Y
(lambda (le)
((lambda (f) (f f))
(lambda (f)
(le (lambda (x) ((f f) x)))))))
个人感觉，即便能看懂以上的变换，也很难理解为什么 Y 算子可以做到可控递归，读完之后基本就会忘记其中的技巧，只留下莫名的惊叹，不觉得很有意义。
为此，我在另外一篇 blog 从 x(x) 到 Y 中从自指角度来梳理 Y 算子，个人觉得比本节的推理更容易理解。
10 What Is the Value of All of This?
本章实现了一个最基础版本的 scheme/lisp 解释器， 核心是用 list 构造一个"运行环境", 以及分解出表达式里各个类型运算符的执行过程。为了区分当前运行的 scheme 语言（racket） 以及被实现的 scheme 语言, 本节中用 lisp 表示被实现的语言，而实现 lisp 的语言称为 scheme, racket 或者本体。
先引入之后要用到的 atom? 函数：
(define atom?
(lambda (x)
(and (not (pair? x)) (not (null? x)))))
环境的定义
entry 是一个 pair, 其中两个元素都是等长的 list, 以下是三个 entry 的例子
'((appetizer entree bevarage)
(pate boeuf vin))
'((appetizer entree bevarage)
(beer beer beer))
'((bevarage dessert)
((food is) (number one with us)))
'((bevarage dessert) ((food is) (number one with us)))
python 中用字典可以方便地表示 entry, 例如以上代码块里第一个 entry 可以表示为：
{"appetizer": "pate", "entree": "boeuf", "bevarage": "vin"}
由于将 pair 作为基础模块（building block），因此引入第 7 章的操作 pair 的函数：
(define build
(lambda (s1 s2)
(cons s1 (cons s2 '()))))
(define first
(lambda (p)
(car p)))
(define second
(lambda (p)
(car (cdr p))))
(define third
(lambda (l)
(car (cdr (cdr l)))))
(define new-entry build)
定义在 entry 中根据 key/name 查询 value 的函数：
(define lookup-in-entry
(lambda (name entry entry-f)
(lookup-in-entry-help
name
(first entry)
(second entry)
entry-f)))
(define lookup-in-entry-help
(lambda (name names values entry-f)
(cond
((null? names) (entry-f name))
((eq? (car names) name) (car values))
(else
(lookup-in-entry-help
name
(cdr names)
(cdr values)
entry-f)))))
(lookup-in-entry
'entree
'((appetizer entree bevarage) (pate boeuf vin))
(lambda (n) '()))
'boeuf
(lookup-in-entry
'no-such-item
'((appetizer entree bevarage) (pate boeuf vin))
(lambda (n) '()))
'()
在 python 中，这些函数等价于字典取值： dictionary[name]
多个 entry/字典组合成 table, 或者叫做 environment, 以下是 table 的例子
'()
'(((appetizer entree beverage) (pate boeuf vin))
((beverage dessert) ((food is) (number one with us))))
'(((appetizer entree beverage) (pate boeuf vin)) ((beverage dessert) ((food is) (number one with us))))
扩充 table 是把一个新的 entry 加入到现有的 table 之前，因此直接就是 cons
(define extend-table cons)
在 table 中查找某个元素函数如下。注意这是一种类似 CPS 的写法（不确定），在递归停止时调用了 table-f, 在递归分支（尽管不是直接调用 lookup-in-table 而是 lookup-in-entry ）则把 table-f 函数不断传递下去，尽管没有搜集什么数据。
(define lookup-in-table
(lambda (name table table-f)
(cond
((null? table) (table-f name))
(else
(lookup-in-entry
name
(car table)
(lambda (name)
(lookup-in-table
name
(cdr table)
table-f)))))))
(lookup-in-table
'beverage
'(((entree dessert) (spaghetti spumoni))
((appetizer entree beverage) (food tastes good)))
(lambda (n) '()))
'good
这些函数和例子在 python 中的一种实现（不需要 continuation，递归等，直观很多）：
table = [{"entree": "spaghetti", "dessert": "spumoni"},
{"appetizer": "food", "entree": "tastes", "beverage": "good"}]
name = "beverage"
def lookup_in_table(name, table):
for entry in table:
if name in entry:
return entry[name]
return None
lookup_in_table(name, table)
good
计算器实现回顾
第八章实现了一个简单的计算器的解释器，首先有一个根据表达式的语法分配语义的函数（从 symbol 到过程），如下：
(define atom-to-function
(lambda (atom)
(cond
((eq? atom '+) +)
((eq? atom 'x) *)
((eq? atom '^) expt)
(else #f))))
(define 1st-sub-exp
(lambda (aexp)
(car (cdr aexp))))
(define 2nd-sub-exp
(lambda (aexp)
(car (cdr (cdr aexp)))))
(define operator
(lambda (aexp)
(car aexp)))
(atom-to-function (operator '(+ 5 3)))
#<procedure:+>
然后直接就可以求值了：
(define value
(lambda (nexp)
(cond
((atom? nexp) nexp)
(else
((atom-to-function (operator nexp))
(value (1st-sub-exp nexp))
(value (2nd-sub-exp nexp)))))))
(value '(+ 1 (^ 3 4)))
82
从这至少可以看到，计算器的实现不需要用到 environment/table 结构
lisp 解释器的结构
scheme 解释器比计算器复杂在哪里？首先计算器是 scheme 的一个子集，因为 scheme 本身是可以做加减乘除等数学计算的，除此之外，scheme 的额外能力在于：
- 逻辑分支： 逻辑判断的运行和数学运算很不一样，它可以跳过某些语句， 而数据计算则需要在所有子表达式上递归求值。
- lambda 表达式：它是让 scheme 解释器需要环境的真正原因，首先 lambda 函数的参数是一个命名系统，执行 lambda 函数实际是执行其函数体（body）中的代码，但问题是 body 里局部变量名都是函数的形参，因此执行前先要把形参和实参绑定起来组成 entry 放到环境中，这样执行到具体的变量名时，才能到环境中查找形参所绑定的值。
- quote: 一种"不需要计算"的所见即所得对象
- 语句中支持不定长参数，计算器能识别的命令长度都是 3，如 (+ exp1 exp2), 也就是参数位置数量都是固定的，因此在固定位置递归就可以了，而 scheme 支持更灵活的参数，这体现在：
- 内置的类型判断函数如
atom?支持一个参数 - lambda 定义的函数支持任意多参数
- cond 也执行任意多参数（尽管不把 cond 的分支称为参数）
- 内置的类型判断函数如
(define expression-to-action
(lambda (e)
(cond
((atom? e) (atom-to-action e))
(else
(list-to-action e)))))
(define atom-to-action
(lambda (e)
(cond
((number? e) *const)
((eq? e #t) *const)
((eq? e #f) *const)
((eq? e 'cons) *const)
((eq? e 'car) *const)
((eq? e 'cdr) *const)
((eq? e 'null?) *const)
((eq? e 'eq?) *const)
((eq? e 'atom?) *const)
((eq? e 'zero?) *const)
((eq? e 'add1) *const)
((eq? e 'sub1) *const)
((eq? e 'number?) *const)
(else *identifier))))
(define list-to-action
(lambda (e)
(cond
((atom? (car e))
(cond
((eq? (car e) 'quote) *quote)
((eq? (car e) 'lambda) *lambda)
((eq? (car e) 'cond) *cond)
(else *application)))
(else *application))))
求值函数：
(define value
(lambda (e)
(meaning e '())))
(define meaning
(lambda (e table)
((expression-to-action e) e table)))
这些函数是高层的实现，后文补充细节。这里关键是展现了要实现的 lisp 语言的所有内置关键词，以及对关键词的分类：
- atom 被分成两类： const 和 identifier, 前者是 scheme 解释器环境里内置对象，后者是 lisp 中用户定义的变量名（由于没有 define 关键字，因此都是 lambda 的形参）
- list 被分成两类：
- 第一个元素是 atom 时，继续细分：
- quote
- lambda
- cond
- 用户自定义的函数变量： 对应是 application
- 第一个元素是 list: 那么这就是执行过程 application
- 第一个元素是 atom 时，继续细分：
目前为止，我们知道了一些大的分类法，知道了语言中要实现的核心功能，其他都还需要进一步理解。
再问一遍，为什么计算器的实现不需要引入环境？而 lisp 的实现却要？
实际上，计算器实现中的 atom-to-function 函数是一个查表过程， 它根据输入表达式里的运算符，从 scheme 的内置函数环境里找到对应的函数，然而由于计算器没有定义变量的能力，缺少 define 或者 lambda 这些关键词, 所以实现中不需要维护一个可动态变化的表示环境的数据结构，直接依赖 scheme 本身执行环境就可以获取内置函数和对象。
因此 environment 的引入是为了可以动态的增加和删除新的变量，这是 lambda 表达式中形参的替换规则所要求的。而 lambda 表达式的 scope 的定义（包括对闭包支持）使得环境必须是分层次的，比如以下的例子：
(cons ((lambda (cons) cons) 1) '())
'(1)
形参用 cons 表示，但它并不会影响最外层的 cons, 这说明在执行 lamba 的时候，必须有一个新的 entry 被创建，执行完后这个环境被释放掉，这样才不会覆盖全局环境里的 cons.
const 和 quote: 对待环境的两个极端
在 lisp 的 atom 类型元素里， const 和 quote 是两个极端，const 意味着这个符号所指的"真实对象" 就在 scheme 解释器环境中，因此直接从本体索取就可以了。而 quote 则相当于自带酒水，把环境写在表达式内部，就在表达式后备箱里（第二个位置）。
(define *const
(lambda (e table)
(cond
((number? e) e)
((eq? e #t) #t)
((eq? e #f) #f)
(else
(build 'primitive e)))))
(define *quote
(lambda (e table)
(text-of e)))
(define text-of second)
此时的 lisp 至少可以对基本元素求值了
(value '#t)
#t
(value '(quote 我自带value的))
'我自带value的
本节的问题是，为什么 *const 实现的 else 分支里要把表达式 e 包裹起来？比如：
(value 'cons)
'(primitive cons)
为什么不能像 数字和 number 一样直接返回 scheme 本体的 procedure:
cons
#<procedure:cons>
或者把数字和 number 也打上一个类似 primitive 的标签？
个人觉得这只是作者的一种选择，把 lisp 中的 number 和 bool 值直接用 scheme 中内置的 number 和 bool，可以减少很多复杂度。当然也可以给 number 和 bool 打上标签，只不过要对操作 number 和 bool 的运算都加上特别的处理，在交给 scheme 的内置数学函数前（如 add1）要把真正的数字和 bool 值取出来。 也可以完全不用 scheme 内置的 number 和 bool 类型，例如第六章中 封装的例子：用 list 表示整数 用 list 来表示整数，这意味着在实现 lisp 中可以不需要有专门的 number 对象，用户直接用 list 来表示整数 即可，但这样会摧毁掉已经不多的测试性，自己都很难验证语言是否有 bug。
给 procedure 打上 primitive 标签是为了区分与用户定义的 lambda 函数，在后文中会更加清晰
（另外一层原因是，如果不用 quote premitive 去给函数打标签，解释器之后看到的就是 #<procedure:cons> 这样的内置函数的原始形式，如果 scheme 内置了根据函数的原始形式而得到函数类型的方法，那么也是可以不用打标签的）
identifier: 对待环境的典范
identifier 是变量，需要到环境中去查询，这是一个标准的三好学生查表操作
(define *identifier
(lambda (e table)
(lookup-in-table e table initial-table)))
(define initial-table
(lambda (name)
(car '()))) ; let's hope we don't take this path
由于要实现的 lisp 不支持 define 关键词，无法自定义全局变量，因此只有定义了 lambda 之后才会出现 identifier，故目前无法单独测试 identifier
cond 的解释
处理条件分支必须用到条件分支：
(define evcon
(lambda (lines table)
(cond
((else? (question-of (car lines)))
(meaning (answer-of (car lines)) table))
((meaning (question-of (car lines)) table)
(meaning (answer-of (car lines)) table))
(else
; we don't ask null?, better one of cond lines be true!
(evcon (cdr lines) table)))))
(define else?
(lambda (x)
(cond
((atom? x) (eq? x 'else))
(else #f))))
(define question-of first)
(define answer-of second)
(define *cond
(lambda (e table)
(evcon (cond-lines-of e) table)))
(define cond-lines-of cdr)
当前就可以计算条件表达了，不过由于无法执行函数， cond 的条件只能用 #t 或 #f 这样的常量：
(value '(cond
(#t (quote number))
(else (quote not-number))))
'number
application: 函数的执行
我把 lambda 表达式的解析和 application 放在同一节，这更利于理解整个解释过程。
本节的目的是对形如 (F x y) 的表达式求值，这里 F 可能是内置函数，例如 cons, 也可能是一个 lambda ，换句话说，本节要理清的是如何计算以下两个典型例子：
(cons x y)((lambda (a b) (+ a b)) x y)
(F x y) 不同于 (quote x) 或者数字 1 的点在于，我们需要建立 F 的形参与实参 x y 的映射表后去执行 F 中的语句，因此无论 F 是内置的还是 lambda, 都需要计算所有实参：
递归地计算
(cdr (F x y))中的值，这是一个典型的构造 list 场景，也就是第三章介绍的(cons typical-element natural-recursion)样子的递归形式:(define evlis (lambda (args table) (cond ((null? args) '()) (else (cons (meaning (car args) table) (evlis (cdr args) table))))))整个函数执行的框架就是先对 F 求值，然后对所有参数求值，并把求值结果一同交给一个新的函数，称为
applyz：(define *application (lambda (e table) (applyz (meaning (function-of e) table) (evlis (arguments-of e) table)))) (define function-of car) (define arguments-of cdr)
applyz 需要检查
(meaning (function-of e) table)的返回值，区分 F 是内置函数还是用户定义的 lambda 函数，在 const 和 quote: 对待环境的两个极端 一节中，对内置函数都打上了一个 primitive 标签，如下：(define *const ... (else (build 'primitive e)))类似的，如果发现当前表达式第一个元素是 lambda 开头的 list, 那么 action 会被解析成
*lambda, 它要给对象打上与 primitive 相对的标签，同时还保存了当前环境的一个副本，用于之后扩充环境以便计算形参的值：(define list-to-action ... ((eq? (car e) 'lambda) *lambda)
(define *lambda (lambda (e table) (build 'non-primitive (cons table (cdr e)))))
applyz 中需要区分 F 的类型，因此先定义区分是否为内置函数的帮助函数：
(define primitive?
(lambda (l)
(eq? (first l) 'primitive)))
(define non-primitive?
(lambda (l)
(eq? (first l) 'non-primitive)))
- 最终 applyz 的主体如下，用
apply-primitive和apply-closure分别计算内置函数和用户定义 lambda 函数
(define applyz
(lambda (fun vals)
(cond
((primitive? fun)
(apply-primitive (second fun) vals))
((non-primitive? fun)
(apply-closure (second fun) vals)))))
- 先看
apply-primitive, 由于当前 fun 可能是 cons 这种接受两个参数的函数，也可能是 car 这类接受一个参数的函数，因此需要对每种函数单独区分（这与计算器实现有很大的不同，计算器只支持双目运算，因此所有运算都是统一的形式）
(define apply-primitive
(lambda (name vals)
(cond
((eq? name 'cons)
(cons (first vals) (second vals)))
((eq? name 'car)
(car (first vals)))
((eq? name 'cdr)
(cdr (first vals)))
((eq? name 'null?)
(null? (first vals)))
((eq? name 'eq?)
(eq? (first vals) (second vals)))
((eq? name 'atom?)
(:atom? (first vals)))
((eq? name 'zero?)
(zero? (first vals)))
((eq? name 'add1)
(+ 1 (first vals)))
((eq? name 'sub1)
(- 1 (first vals)))
((eq? name 'number?)
(number? (first vals))))))
(define :atom?
(lambda (x)
(cond
((atom? x) #t)
((null? x) #f)
((eq? (car x) 'primitive) #t)
((eq? (car x) 'non-primitive) #t)
(else #f))))
注意以上 :atom? 是为了区分打了 primitive 标签的内置函数或 lambda 函数
(value '(atom? cons))
#t
因此以下 lambda 表达式也是 atom
(value '(atom? (lambda (x) x)))
#t
- 最后是对 lambda 的 apply
这类似盗梦空间里进入下一层梦境，从 closure 中取出形参 (formals-of closure) 与实参 vals 绑定，然后构建一个新的 entry 加入到目前的环境 (table-of closure) 中，然后在该环境下执行 (body-of closure) 就可以了，好一个偷梁换柱！
(define apply-closure
(lambda (closure vals)
(meaning
(body-of closure)
(extend-table (new-entry
(formals-of closure)
vals)
(table-of closure)))))
(define table-of first)
(define formals-of second)
(define body-of third)
至此，整个 lisp 解释器就实现了！
- 更多测试：
(value '(add1 6))
7
(value '(quote (a b c)))
'(a b c)
(value '(car (quote (a b c))))
'a
(value '(cdr (quote (a b c))))
'(b c)
(value
'((lambda (x)
(cons x (quote ())))
(quote (foo bar baz))))
'((foo bar baz))
(value
'((lambda (x)
(cond
(x (quote true))
(else
(quote false))))
#t))
'true
番外篇：lisp 解释器的 python 实现
为了检验自己是否真的理解每个步骤，这里用 python 重新实现，在用另外的语言实现相同功能过程中更容易理解 scheme 的特殊之处。
环境的定义
这在 scheme 实现 lisp 时已经实现过：
def lookup_in_table(name, table):
for entry in table:
if name in entry:
return entry[name]
return None
补充上 table 扩展，
def new_entry(names, values):
return dict(zip(names, values))
def extend_table(entry, table):
return [entry, *table]
表达式是 list 还是字符串？
接着要考虑 expression-to-action 的实现, 这就面临了第一大问题：该用什么结构来表示 expression ?
在 scheme 中，由于有 quote 的概念，可以非常容易地把本体的 scheme 语言变成实现的 lisp 语言。 例如以下是在执行 scheme 语言（尽管报错）：
(value (lambda (x) x))
car: contract violation expected: pair? given: '() context...: body of top-level
以下则是在解释 lisp 语言
(value '(lambda (x) x)) ;(value (quote (lambda (x) x)))
'(non-primitive (() (x) x))
scheme 的这种随时可以把语言本身变成语言操作对象的特性使得实现一个语法和自身相似的语言（元循环解释器）变得更加方便。
对于 python, (lambda (x) x) 表达式只能以 string 的形式 quote 起来作为数据传给解释函数。但即便这样， python 又没有方便地操作这种 string 表达式的函数，作为对比， scheme 里 car cdr cons 是内置的（也就是说 scheme 的内置函数本身就是设计出来操作 scheme 自身语法的，我称它为自操作属性）
如果要在 python 中实现这类操作，就需要一个解析字符串表达式的语法解析函数（parser）， 这会让实现变得稍微复杂，因此我选择从 python 中找一个最接近 scheme 自操作属性的语言特性来实现。
这里选择用 python 的 list 作为语言的结构描述（和 scheme 保持尽量一致），对于所有非 python 内置的可引用变量，全部用 string 表示，如下是 (lambda (x) x) 的定义，注意无法消除逗号
["lambda", ["x"], "x"]
然而以上方式会导致编写表达式的时候对 list 里的变量都要加上引号，比较繁琐，为此可以在 python 全局环境中预定义一些变量，例如只要定义：
L = "lambda"
x = "x"
就可以把以上表达式写成：
[L, [x], x]
这样方便很多，注意用 L 是避免覆盖默认的 lambda，由于有许多给 lisp 预留的关键词或者常用参数名，为了避免一个个用 x="x" 的形式定义，可以用以下方式来注入到 python 全局环境中（相当于给 python 增加了部分关键字，或许考虑尽量复用 python 的 builtin 函数？）：
globals()['y'] = "y"
y
y
这样只要把预留变量保存起来，就可以批量加入到 python 的内置环境中：
lisp_built_in_const = {"cons", "car", "cdr", "null?", "eq?", "atom?", "zero?", "add1", "sub1", "+", True, False}
lisp_built_in_keyword = {"cond", "quote"}
以上 True, False 是为了之后判断表达式是否为 const 类型而加入的，和上一章 scheme 实现 lisp 一样，真值用 python 原生的 True 和 False 替代 #t 和 #f
添加关键字：
for const in lisp_built_in_const | lisp_built_in_keyword:
if type(const) == str and not const.endswith("?"):
globals()[const] = const
L = "lambda"
以上过滤了结尾是 "?" 的内置函数，因为 python 无法支持带 ? 的变量，如果 lisp 中要用到，则直接用字符串表示 , 另外 else 和 python 原生的一样，因此也用字符串 "else" 表示。
经过这些处理后，可以在 python 环境中写出以下表达式而不报错：
[cond, [True, cdr], ["else", cons]]
它看上去是一个普通的 python list, 实际又是可执行的 lisp 代码。
lisp 解释器的结构
因此 expression_to_action 定义如下
def expression_to_action(e):
if is_atom(e):
return atom_to_action(e)
return list_to_action(e)
def atom_to_action(e):
if type(e) == int or e in lisp_built_in_const:
return _const
return _identifier
def list_to_action(e):
non_application = ["quote", "lambda", "cond"]
if e[0] in non_application:
# 获得 python 环境里的对应函数
return globals()["_" + e[0]]
return _application
is_atom = lambda e: type(e) != list
value = lambda e: meaning(e, [])
meaning = lambda e, table: expression_to_action(e)(e, table)
atom 的解释
本节实现 const, quote 和 identifier 的解释
def _const(e, table):
if type(e) == int:
return e
if e in [True, False]:
return e
return ["primitive", e]
_quote = lambda e, table: e[1]
_identifier = lambda e, table: lookup_in_table(e, table)
当前就可以计算 const 和 quote
value([quote, "我自带value的"])
我自带value的
value(cons)
['primitive', 'cons']
cond 的解释
def evcon(lines, table):
for line in lines:
assert len(line) == 2
if is_else(question_of(line)) or meaning(question_of(line), table):
return meaning(answer_of(line), table)
question_of = lambda e: e[0]
answer_of = lambda e: e[1]
is_else = lambda x: x == "else"
def _cond(e, table):
return evcon(cond_lines_of(e), table)
cond_lines_of = lambda e:e[1:]
当前就可以计算条件表达了，不过由于无法执行函数， cond 的条件只能用 True 或 False 这样的常量：
value([cond,
[False, [quote, "number"]],
["else", [quote, "else branch"]]])
else branch
application: 函数的执行
- 对所有参数求值：
def evlis(args, table):
return [meaning(arg, table) for arg in args]
def _application(e, table):
return applyz(meaning(function_of(e), table), evlis(arguments_of(e), table))
function_of = lambda e: e[0]
arguments_of = lambda e: e[1:]
def _lambda(e, table):
return ["non-primitive", [table, *e[1:]]]
def applyz(fun, vals):
if is_primitive(fun):
return apply_primitive(fun[1], vals)
return apply_closure(fun[1], vals)
def is_primitive(fun):
return fun[0] == "primitive"
apply_primitive 原本是通过大量的条件分支实现的（更好的方式可能是做成字典放在 global 环境中）
def apply_primitive(name, vals):
if name == "cons":
return vals[:2] if type(vals[1]) != list else [vals[0],*vals[1]]
if name == "car":
return vals[0][0]
if name == "cdr":
return vals[0][1:]
if name == "null?":
return vals[0] == []
if name == "eq?":
return vals[0] == vals[1]
if name == "atom?":
return is_lisp_atom(vals[0])
if name == "zero?":
return vals[0] == 0
if name == "add1":
return vals[0] + 1
if name == "sub1":
return vals[0] - 1
if name == "+":
return sum(vals)
if name == "number?":
return type(vals[0]) == int
def is_lisp_atom(vals):
if is_atom(vals):
return True
if len(vals) == 0:
return False
return vals[0] in ["primitive", "non-primitive"]
内置函数和 lambda 函数都是 atom 类型：
value(["atom?", cons])
True
value(["atom?", [L, [x], x]])
True
最后是对 lambda 的 apply:
def apply_closure(closure, vals):
return meaning(body_of(closure),
extend_table(new_entry(formals_of(closure), vals),
table_of(closure)))
table_of = lambda closure: closure[0]
formals_of = lambda closure: closure[1]
body_of = lambda closure: closure[2]
至此，整个 lisp 解释器就实现了！ 更多的测试：
for expression in [[add1, 6],
[quote, ["a", "b", "c"]],
[car, [quote, ["a", "b", "c"]]],
[cdr, [quote, ["a", "b", "c"]]],
[[L, [x],
[cons, x, [quote, []]]],
[quote, ["foo", "bar", "baz"]]],
[[L, [x],
[cond,
[x, [quote, "true"]],
["else", [quote, "false"]]]],
True]
]:
print(value(expression))
7 ['a', 'b', 'c'] a ['b', 'c'] [['foo', 'bar', 'baz']] true
python-lisp 中 Y 的实现
lisp_Y = [L, ["le"],
[[L, [x], [x, x]],
[L, ["f"],
["le", [L, [x], [["f", "f"], x]]]]]]
sum_ = [L, [x],
[L, ["n"],
[cond,
[["zero?", "n"], 0],
["else", ["+", [x, [sub1, "n"]], "n"]]]]]
value([[lisp_Y, sum_], 100])
5050
fib = [L, [x],
[L, ["n"],
[cond,
[["zero?", [sub1, "n"]], 1],
[["zero?", "n"], 1],
["else", ["+", [x, [sub1, "n"]], [x, [sub1, [sub1, "n"]]]]]
]]]
value([[lisp_Y, fib], 10])
89