Z's Yard[中文]: 五月 2011

看来以后得换标题，用用一个标题的话内容就越写越乱了。要一个内容集中的短篇，比如写一篇叫《用Python实现简单的Scheme解释器》之类的，反而效果会更好一点。
不过有一个事实是，在写一样东西前后需要考虑这样一些因素：缩写的内容是针对者，要准备哪些资料，要用多少的时间来写，内容是否可靠，通过这一过程双方可以获得什么。
其中的事实便是，任何事情都可以说成是无意义的，任何事情都可以看成一蹴而就的。而在此偏执的假设这下以虚度的无意义去代替偏执的存在意义，也不是什么积极的看法。
当将世界中的个体看作了一个十分易碎的存在，以无意义的碎片填补碎片拼接而成的容积，虽空间存在却不成为容器。
关于涉及的知识点呢还是系统些为好，毕竟内容零碎的话效率不高且不大可靠，积累什么的好事必要的。就心态而言，目的还是希望在写的过程中得到练习，至少算是做一些手工活吧。

* Scheme Toy #24 Pavilion
ee.zsy 2011年02月25日 23:52

于是开始准备第二期的内容了，会补充前面写过的东西，然后再加一点新的内容。
前面写的东西有些地方有些差错有点含糊缺少示例，这些都会对写过的做更多说明。
至于新安排的内容的话，会在再后一些的编目里再涉及。
包括前面因时间关系计划了但还没写的东西，也会展示一些新的视角。

当初说这叫一系列科普文，不过写来发觉也没什么一定要让人知道的东西。
所以呢，接下来的篇目就当茶余饭后的消遣好了。
我会努力让接下来的内容说明得明了有趣，把简单东西以直观的方式展示出来。
同时呢，之后的编目形式会有一些改变：
篇目之间将不再有关联，将没有固定的更新时间，每篇将只简短的说一件事情。
这样的好处是别人阅读起来减少了阻碍，而自己写起来也比较省事。
因为这样看单个篇目的时候不必再参前顾后，而只要保证其中说到有趣的东西就可以了。

至于说什么叫有趣，我想这里所说的有趣就是指：
某些事情常遇到，并总在其中有所察觉，感觉它很简单，却同时又感觉复杂得找不到头绪。
而某些文字，将这样的事情记录于纸上，显示在屏幕上，让人在阅读之中发掘着自己思路。
就好像在说人有惰性，却又由这种特性出发并去为了满足这种特性而不懈的努力着的事情。

于是最后，对接下来的内容留一个愿望，给自己的，也是给别人的。
这个愿望的名字叫——期待。

* Scheme Toy #25 Exercise
ee.zsy 2011年02月26日 16:48

就是标题的意思，本篇是一些简单基础的题目以供热身，算是前后内容的衔接作用。
一共99道题，循序渐进地涵盖若干方面的小问题，以下只给出了题目未附答案。
这些内容算是对前面的内容的一个总结，也将作为之后内容展开的一个基础。
部分内容以作为示例在前面的篇目里说到，余下的会在之后编目里补充说明的。
当然，这篇没有什么严肃的内容，且当是娱乐的目的，或者说算整理思路用。

来源是
P-99: Ninety-Nine Prolog Problems
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/
L-99: Ninety-Nine Lisp Problems
http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html
H-99: Ninety-Nine Haskell Problems
http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems

那么，下面开始了：

S-99: Ninety-Nine Scheme Problems

题目开始前先做些说明，比如说我的翻译不是很可靠之类的提醒：
此外，后面的题目可以使用前面定义题目过的函数，可以处理结果，也可以组合使用。
要求是结果正确即可，暂不比太考虑性能的问题，以及错误处理方面的问题。
为对照方便，内容尽可能直译其他语言的版本了，所以一些函数会不大符合scheme的习惯。

【列表】

P01 (*) 返回列表的最后一个元素。
例如：(my-last '(a b c d)) ;=> d

P02 (*) 返回列表的最后两个元素。
例如：(my-but-last '(a b c d)) ;=> (c d)

P03 (*) 返回列表的第k个元素。
例如：(element-at '(a b c d e) 3) ;=> c

P04 (*) 返回列表的元素个数。

P05 (*) 倒置（reverse）一个列表。

P06 (*) 判断一个列表是否回文。
例如：(x a m a x)符合要求。

P07 (**) 弄平（flatten）嵌套列表。
例如：(flatten '(a (b (c d) e))) ;=> (a b c d e)

P08 (**) 去除列表中连续的冗余元素。
例如：(compress '(a a a a b c c a a d e e e e))
;=> (a b c a d e)

P09 (**) 将连续元素归为一个子列表。
例如：(pack '(a a a a b c c a a d e e e e))
;=> ((a a a a) (b) (c c) (a a) (d) (e e e e))

P10 (*) 编码列表连续元素的长度。
例如：(encode '(a a a a b c c a a d e e e e))
;=> ((4 a) (1 b) (2 c) (2 a) (1 d)(4 e))

P11 (*) 处理在P10的编码结果，保留单独的元素。
例如：(encode-modified '(a a a a b c c a a d e e e e))
;=> ((4 a) b (2 c) (2 a) d (4 e))

P12 (**) 解码P11编码后的结果。

P13 (**) 编码列表连续元素的长度，保留单独的元素（直接定义，不使用P11的过滤器风格）。
例如：(encode-direct '(a a a a b c c a a d e e e e))
;=> ((4 a) b (2 c) (2 a) d (4 e))

P14 (*) 重复列表中的元素。
例如：(dupli '(a b c c d)) ;=> (a a b b c c c c d d)

P15 (**) 重复列表元素k次。
例如：(repli '(a b c) 3) ;=> (a a a b b b c c c)

P16 (**) 忽略列表中n的倍数的元素。
例如：(drop '(a b c d e f g h i k) 3) ;=> (a b d e g h k)

P17 (*) 将列表分割为前n个元素以及余下的部分。
例如：(split '(a b c d e f g h i k) 3)
;=> ((a b c) (d e f g h i k))

P18 (**) 返回列表两个下标之间的片段。
例如：(slice '(a b c d e f g h i k) 3 7) ;=> (c d e f g)

P19 (**) 把列表向左旋转n位。
例如：(rotate '(a b c d e f g h) 3) ;=> (d e f g h a b c)
以及：(rotate '(a b c d e f g h) -2) ;=> (g h a b c d e f)

P20 (*) 移除列表的第n个元素。
例如：(remove-at '(a b c d) 2) ;=> (a c d)

P21 (*) 在列表的指定位置添加元素。
例如：(insert-at 'alfa '(a b c d) 2) ;=> (a alfa b c d)

P22 (*) 创建表示给定范围数的列表，能根据范围升序或逆序。
例如：(range 4 9) ;=> (4 5 6 7 8 9)

P23 (**) 随机选取列表中n个元素（已给随机函数random）。
例如：(rnd-select '(a b c d e f g h) 3) ;=> (e d a)

P24 (*) 抽取n个不重复的小于m的正整数。
例如：(lotto-select 6 49) ;=> (23 1 17 33 21 37)

P25 (*) 生成列表的随机排列。
例如：(rnd-permu '(a b c d e f)) ;=> (b a d c e f)

P26 (**) 生成列表中k个元素组成的所有排列（结果包含c(n,k)个）。
例如：(combination 3 '(a b c d e f))
;=> ((a b c) (a b d) (a b e) ... )

P27 (**) 将集合的元素分组，满足对每项任务所需要的元素个数的全部组合。
例如：(group '(aldo beat carla david evi flip gary hugo ida) '(2 2 5))
;=> (((aldo beat) (carla david) (evi flip gary hugo ida)) ... )

P28 (**) 按照子列表的元素个数排序一个列表。
例如：按照子表的元素个数升序排列
(lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
;=> ((o) (d e) (d e) (m n) (a b c) (f g h) (i j k l))
或者：按照子列表长度出现的次数升序排列
(lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
;=> ((i j k l) (o) (a b c) (f g h) (d e) (d e) (m n))

【运算】

P31 (**) 判断所给的整数是否为素数。
例如：(is-prime 7) ;=> #t

P32 (**) 使用欧几里德算法计算两个正整数的最大公约数。
例如：(gcd 36 63) ;=> 9

P33 (*) 判断两个真整数是否互质（最大公约数为1）。
例如：(coprime 35 64) ;=> #t

P34 (**) 计算欧拉函数（euler's totient function）phi(m)，即在区间[1,m]上于m互质的数r的个数。
例如： m = 10: r = 1,3,7,9; 所以 phi(m) = 4. 特别的: phi(1) = 1.
(totient-phi 10) ;=> 4
注意：这里先直接按照定义求，后面有更为巧妙的求法。

P35 (**) 判断给定正整数的质因数（升序）。
例如：(prime-factors 315) ;=> (3 3 5 7)

P36 (**) 分解质因数，以表示为指数形式。
例如：(prime-factors-mult 315) ;=> ((3 2) (5 1) (7 1))

P37 (**) 计算欧拉函数（euler's totient function）phi(m) （改进）
结合P34和P36，当质因数和它的指数表示为((p1 m1) (p2 m2) (p3 m3) ...)时，
可以计算：Phi(m)=(p1-1)*p1**(m1-1)+(p2-1)*p2**(m2-1)+(p3-1)*p3**(m3-1)+...

P38 (*) 比较不同的欧拉函数的算法。
例如：P34和P37在计算phi(10090)时的性能差异。

P39 (*) 构造给定范围里的素数列表。

P40 (**) 哥德巴赫猜想，即将给定的大于2的偶数分解为两个质数的和。
例如：(goldbach 28) ;=> (5 23)

P41 (**) 生成哥德巴赫猜想组合的列表。
例如：生成给定返回内所有偶数的展开
(goldbach-list 9 20) ;=>
10 = 3 + 7
12 = 5 + 7
14 = 3 + 11
16 = 3 + 13
18 = 5 + 13
20 = 3 + 17
或者：再限定一个参数表示加数的最小值，因为通常其中会有一个加数是很小的质数
(goldbach-list 1 2000 50);=>
992 = 73 + 919
1382 = 61 + 1321
1856 = 67 + 1789
1928 = 61 + 1867

【逻辑和编码】

P46 (**) 构造逻辑表达式的真值表。
例如：(table 'A 'B '(and A (or A B))) ;=>
true true true
true fail true
fail true fail
fail fail fail

P47 (*) 构造逻辑表达式的真值表，操作符使用自然顺序。
例如：(table 'A 'B '(A and (A or not B))) ;=>
true true true
true fail true
fail true fail
fail fail fail

P48 (**) 构造逻辑表达式的真值表，自变量为一个列表。
例如：(table '(A B C) '(A and (B or C) equ A and B or A and C)) ;=>
true true true true
true true fail true
true fail true true
true fail fail true
fail true true true
fail true fail true
fail fail true true
fail fail fail true

P49 (**) 格雷码（Gray code）。
例如：n位格雷码按照一定规则生成n位字符序列
(c 1) ;=> ("0" "1")
(c 2) ;=> ("00" "01" "11" "10")
(c 3) ;=> ("000" "001" "011" "010" "110" "111" "101" "100")

P50 (***) 霍夫曼编码
例如：对一个符号出现频率的集合
'((a 45) (b 13) (c 12) (d 16) (e 9) (f 5))，
构建符号对因的霍夫曼编码列表
'(a "0") (b "101") (c "100") (d "111") (e "1101") (f "1100"))

* Scheme Toy #25.5 Exercise B
ee.zsy 2011年02月27日 15:12

接着上篇的内容，原文的题目序号就是这么标的，别问我P51在哪里。
此外，一些名词有些想当然翻译了，肯定会不大符合习惯用法，无奈。
原文内容中说明部分未直接翻译，可能看起来会有点那么不够详尽。
此外这些题目的出发点不是解是如何，而是说思考过程怎样会比较有效。

那么，正文开始了：

【二叉树】

这里以(X L R)表示一个树的节点，然后以嵌套的形式构成一颗二叉树。
例如：https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p67.gif
表示为 '(a (b (d () ()) (e () ())) (c () (f (g () ()) ())))

P54A (*) 判断所谓的列表是否为二叉树。
例如：(istree '(a (b () ()) ())) ;=> #t
或者：(istree '(a (b () ()))) ;=> #f

P55 (**) 构造完全平衡二叉树，即每个节点的左右子树的节点个数相差不大于一。
例如：生成n节点所有可能的树的排序(cbal-tree 4) ;=>
(x (x () ()) (x () (x () ())))
(x (x () ()) (x (x () ()) ()))
...

P56 (**) 判断二叉树是否对称（左右树镜像对称）。

P57 (**) 生成二叉搜索树（字典）。
例如：(construct '(3 2 5 7 1)) ;=>
(3 (2 (1 () ()) ()) (5 () (7 () ())))

P58 (**) 使用filter（Generate-and-test）模式，生成n个节点的对称完全平衡二叉树。
例如：(sym-cbal-trees 5) ;=>
((x (x () (x () ())) (x (x () ()) ())) (x (x (x () ()) ()) (x () (x () ()))))

P59 (**) 构造高度平衡二叉树，即每个节点的左右子树的高度不大于1。
例如：(hbal-tree 3) ;=>
(x (x (x () ()) (x () ())) (x (x () ()) (x () ())))
(x (x (x () ()) (x () ())) (x (x () ()) ()))
...

P60 (**) 构造高度为n的高度平衡二叉树，计算可构造出的个数。
例如：(count_hbal_trees 15) ;=> 1553

P61 (*) 统计叶节点（没有子树的节点）的个数。

P61A (*) 返回树的叶节点列表。

P62 (*) 返回二叉树的分支节点列表。

P62B (*) 返回第n层的所有节点的列表。

P63 (**) 构造n个节点的完全二叉树，即节点从左至右依层树排列。

P64 (**) 排版二叉树，即以字符矩阵使树可视化，每纵列只有一个节点紧凑排列。
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p64.gif

P65 (**) 排版二叉树，每层的两个节点（包括空节点）等距排列。
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p65.gif

P66 (***) 排版二叉树，纵列上可以有多个节点，紧凑。
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p66.gif

P67 (**) 用字符串（例如"a(b(d,e),c(,f(g,)))"）表示二叉树，于列表形式互相转换。

P68 (**) 生成二叉搜索树的先序与中序序列。

P69 (**) 用"."表示空节点，将二叉树的节点显示为字符串。
例如:P67中的树可以表示为“abd..e..c.fg...”

【多叉树】

多叉树的节点可以有多个子树，并称这些树为森林。
这里以(X F)表示树的节点，F是节点子树的列表（可为空）。
例如：https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p70.gif
表示为(a ((f ((g ()))) (c ()) (b ((d ()) (e ())))))

P70B (*) 判断一个列表是否表示多叉树。
例如：(istree '(a ((f ((g ()))) (c ()) (b ((d ()) (e ())))))) ;=> #t

P70C (*) 统计多叉树的节点个数。
例如：(nnodes '(a ((f ())))) ;=> 2

P70 (**) 以字符串表示多叉树的深度优先遍历过程，字符"^"表示回溯。
例如：https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p70.gif
表示为"afg^^c^bd^e^^^"

P71 (*) 判断树的内部路径长度，即根节点到每个节点的长度的总和。
例如：P70中的树的结果是9

P72 (*) 从一颗树由底像上构建一个序列。

P73 (**) 将树的列表形式输出为s表达式的字符串。
例如：(tree-ltl(a ((b ()) (c ())))) ;=> "(a(bc))"

【图】

图被定义为节点的集合加上边的集合，其中边指的是一对节点。
存在若干中方式来表示图的数据：
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/graph1.gif
一种方式是只储存边，写为边的列表'((h g) (k f) (f b) ... );
不过有节点无边相临，加上节点写为
'((b c d f g h k) ((b c) (b f) (c f) (f k) (g h)))
还有一种方式称为邻接列表，储存节点相邻的节点
'((b (c f)) (c (b f)) (d ()) (f (b c k)) ... )
此外也需要可视化的手段，可以直观地观察数据所表现的图形。

如果边有方向，那么表示边的点对就是有序点对，此时图称为有向图。
当边包含各自的属性时，图称为标示图。
当节点之间可存在多条边时，图称为多重图。

P80 (***) 转换，将图转换不同表示方式的同一个图。

P81 (**) 输出两个节点之间的非循环路径。

P82 (*) 输出由一个节点出发后所有的循环路径。

P83 (**) 构造所有的生成树，使用回溯。
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p83.gif

P84 (**) 构建最小生成树，使用Prim算法。
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p84.gif
可由P83的代码修改。

P85 (**) 判断图的同构，即在一个图中两个点是相邻的当且仅当它们在另一个图中也是相连的，使用列表记录映射关系。

P86 (**) 给图着色，使得相邻节点的颜色不同，且用色最少。

P87 (**) 图的深度优先顺序遍历。

P88 (**) 把图分割为连接组件。

P89 (**) 判断所给图是否是二分图。

【综合】

90 (**) 八皇后问题，即在棋盘上放置八个皇后满足她们不能互相攻击。

P91 (**) 骑士之旅，即判断骑士（马）能否不重复地走遍棋盘上所有的格子。

P92 (***) 冯科赫猜想，给图的n个节点从1开始编号使得边的标号是两节点之差也满足这样的编号序列。
见图：
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p92a.gif
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p92b.gif

P93 (***) 算数题，对给定数列在数之间添加+-*/=使得算式成立。
例如：(2 3 5 7 11)可以2-3+5+7 = 11或2 = (3*5+7)/11以及十种别的方式。

P94 (***) 生成n个节点的k正则简单图，使得每个节点连有k边，全部不同够的解。

P95 (**) 把数字写为单词的形式。
例如：正整数175对应写为one-seven-five。

P96 (**) 语法检查，检查输入序列是否满足语法。
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p96.gif

P97 (**) 数独，要求根据数独的规则对给定题目求出解答。

P98 (***) Nonograms，一个上世纪九十年代流行过逻辑游戏。

P99 (***) 填字（Crossword）游戏。
https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/p99.gif

* Scheme Toy #26 GCD
ee.zsy 2011年03月01日 13:41

这里的GCD是Greatest Common Divisor的缩写，意为最大公约数。
本编内容拿一些简单的东西来说说，只涉及基础的数学和计算机知识。
实例代码主要以Scheme语言，仅作为表达方式，不作为现在这部分的侧重。

首先的说质数，指大于1的自然数中不能被1和自身之外的自然数整除的数。

先只考虑结果的正确性，可以写出这样的代码：
(define (prime? x) (every? (lambda (i) (not (divides? i x))) (test-range-of x)))
其中x限定为大于1的自然数，并留下三个过程有待定义。

整除的意思是两数相处余数为零，即x能整除y等价于y除以x后所得余数为零：
(define (divides? x y) (zero? (remainder y x)))

对于所给的数x，测试范围是区间[2,y]的整数。其中y为(sqrt x)，且当y<2时区间为空：
(define (test-range-of x) (range 2 (sqrt x)))
并且，这里的range用来定义一个惰性求值的列表[low,high]：
(define (range low high) (if (<= low high) (cons low (delay (range (+ low 1) high))) '()))

当测试范围里有元素不满足条件时，返回的结果就可以是false：
(define (every? pred stream)
(if (null? stream) #t (if (pred (car stream)) (every? pred (force (cdr stream))) #f)))

现在已经可以来做测试了：
(map prime? '(2 3 4 5 6 7 8 9))
;=> (#t #t #f #t #f #t #f #f)

用存在命题改写前面的全称命题，可写出逻辑等价的一个过程：
(define (prime? x) (not (any? (lambda (i) (divides? i x)) (test-range-of x))

当test-range-of只是返回一个列表时，可以补充定义：
(define (any? pred list)
(call-with-current-continuation
(lambda (return) (map (lambda (i) (if (pred i) (return #t))) list) #f)))

上面展示了通过基本的运算组合于抽象的一个过程，分解的较细，所以显得有些冗余。

写为一个单独的过程可以表达为：
(define (prime? x)
(let loop ((i 2))
(cond
((> i (sqrt x)) #t)
((zero? (remainder x i)) #f)
(else (loop (+ i 1))))))
(map prime? '(2 3 4 5 6 7 8 9))
;=> (#t #t #f #t #f #t #f #f)

同时现在这个版本可以略作修改，用来用来返回最小的一个因数：
(define (smallest-divisor x)
 (let loop ((i 2))
 (cond
 ((> i (sqrt x)) x)
 ((zero? (remainder x i)) i)
 (else (loop (+ i 1))))))
(map smallest-divisor '(2 3 4 5 6 7 8 9))
;=> (2 3 2 5 2 7 2 3 2 11)

此时判断质数的过程又可定义为：
(define (prime? x) (= (smallest-divisor x) x))

于是接下来们可以得到一个数的全部因式，即分解质因数的过程：
(define (factor x)
 (let ((i (smallest-divisor x)))
 (if (= i x)
 (list x)
 (cons i (factor (/ x i))))))
(factor 2012)
;=> (2 2 503)

如果觉得递归空间复杂度高的话，可以改写为等价的尾递归形式：
代码略

于是终于回到主题gcd上来了，即求两个数的共有的质因数。
(define (gcd x y) (apply * (intersection (factor x) (factor y))))

这里求两列表中共有的元素概念，由于factor的结果是由小到大排列的，这里使用了一个有针对的算法：
(define (intersection x y)
 (if (or (null? x) (null? y))
 '()
 (let ((x1 (car x)) (y1 (car y)))
 (cond ((= x1 y1) (cons x1 (intersection (cdr x) (cdr y))))
 ((< x1 y1) (intersection (cdr x) y))
 ((< y1 x1) (intersection x (cdr y)))))))

此时可以测试上面的求最小公因数过程了：
(gcd 40 36) ;=> 4
(map (lambda (i) (apply gcd i)) '((2 3) (160 128) (2000 2012))) ;=> (1 32 4)

下面来关注一下刚才缩写的gcd函数的性能，特别是其中的factor过程：
它对一个数将使用smallest-divisor，并转而对其余数进一步分解，直到得到一个素数。
这个分解过程的最好情况是所给的数已是一个素数，只需要比较比较它的测试区间全部的数。

不过这依然是一个很大的开销，而有时在仅需要一个有极大可能是素数的数即可。
例如一种判断可能为素数的随机化算法称为费马素性检验，被用于数据加密之中。

从简化复杂度的角度看求最大公约数，有一种为人熟知的方法，它就是欧几里德算法。
这里的算法又称为辗转相除法，即把两数中较大的剪去较小的再与较小的数求最大公约数。
这一过程不断缩小两数的值直到其中一数为零，而另一个数与原先两数的最大公约数数值相等。
运用取模运算可以是这一过程表现的略微简单一些，可以写出：
(define (gcd x y) (if (zero? y) x (gcd y (modulo x y))))
(gcd 40 36) ;=> 4

有了最大公约数的求法，可以进而求出两数的最小公倍数以及约去分式中的公因子。

最后，来说一说求指数的，求一个数的正整数次幂可以通过反复相称得到结果：
(define (exp x y)
 (let loop ((i y) (r 1))
 (if (zero? i)
 r
 (loop (- i 1) (* r x)))))
(exp 2 3) ;=> 8

这里对于n次幂就进行了n次乘法，从降低算法复杂度的方面可以改进为：
(define (exp b n)
 (cond ((= n 0) 1)
 ((even? n) (square (exp b (/ n 2))))
 (else (* b (exp b (- n 1))))))
(exp 2 3) ;=> 8

以上是将一个递归的分段函数直接写为对应的符号表达式的，算很符合思维直觉吧。
例如在计算x^25过程中分解为了x*(((x*x^2)^2)^2)^2来计算，只计算了6次乘法而不是25次。

此篇算是第二期施工的第一篇正文，先按这么简单罗列的方式来写一下吧。
虽然只是些基本而简单的内容，还是希望上面的写法能按设想中的发掘出有趣的东西。

* Scheme Toy #27 Matrix
ee.zsy 2011年03月04日 17:24

标题的Matrix是矩阵的意思，表现为一个矩形数组。

矩阵在数学中是一个抽象工具，它：
可以用来表示一个二维元祖到一个原子的映射关系，
可以用来表示矩阵之间的映射关系，
或者可以通过矩阵的变换来表示线性变换。

在计算机中，可以用向量的向量来表示一个矩阵。
例如在Scheme语言中可以将一个2*3的矩阵写为如下方式：
(define m1
 #(#(1 2)
 #(4 5)
 #(7 8)))

首先需要定义一个谓词，判断是否为矩阵。
该过程的检查要求类型为向量且子向量长度相等。
(define (matrix? x)
 (and
 (vector? x)
 (let ((maplist (vector->list x)))
 (and
 (call-with-current-continuation
 (lambda (return)
 (map (lambda (i) (if (not (vector? i)) (return #f))) maplist) #t))
 (apply = (map vector-length maplist))))))
(matrix? m1) ;=>#t

现在假定下面出现的过程的参数中的矩阵已经满足了matrix?，
为了表述的简单以及重复检查不必要的性能损耗，将不写有关的异常检测。
下标溢出的情况暂且只保证不能得到运算结果，而暂无处理机制。

矩阵表现为row*column的形式，于是可以定义如下过程：
(define (vector-map fun vec) (list->vector (map fun (vector->list vec))))
(define (row m i) (vector-ref m (- i 1)))
(define (col m i) (vector-map (lambda (x) (vector-ref x (- i 1))) m))
(row m1 2) ;=> #(4 5)
(col m1 2) ;=> #(2 5 8)
这里定义了两个行数用于从矩阵中获取行列，初始下标取1。
vector-map的为效率之后改用有副作用的方式吧。

接下来定义以下标方式读写矩阵的过程，这是以后定义的过程的基础。
数据使用向量而没有使用数组会在下标上有性能优势，迭代使用下标进行：
(define (times n func) (do ((i 0 (+ i 1))) ((= i n)) (func i)))
(define (make-matrix row col)
 (let ((m (make-vector col)))
 (times col (lambda (i) (vector-set! m i (make-vector row))))
 m))
(define (matrix-ref mat row col)
 (vector-ref (vector-ref mat (- col 1)) (- row 1)))
(define (matrix-set! mat row col val)
 (vector-set! (vector-ref mat (- col 1)) (- row 1) val))
(define (matrix-row-length m) (vector-length (vector-ref m 0)))
(define (matrix-col-length m) (vector-length m))
(define m2 (make-matrix 3 2))
(matrix-set! m2 1 2 3)
(matrix-ref m1 2 3) ;=>8
m2 ;=> #(#(0 0 0) #(3 0 0))
(matrix-row-length m2) ;=> 3
(matrix-col-length m2) ;=> 2

定义好了矩阵类型，在已定义的方法的基础上，便可以开始一些对矩阵的方法了。
下面出现的一些使用矩阵的过程在实现上处于性能考虑，使用了有副作用的方式。
也可以在包装出一个纯函数版本，除了像有些操作是不大方便在原矩阵上直接修改。
（注意，通常说n row m col的矩阵应该是m*n的矩阵，而这里所写的不大对劲。）

首先来说对单个矩阵的操作，这里以高斯消元法为例子，然后看看顺便能说到什么。

高斯消元法是以矩阵的初等变换为基础的，矩阵的若干特征在这些变换后保持不变：
;;;dup
(define (matrix-copy m)
 (define (vector-copy v)
 (define nv (make-vector (vector-length v)))
 (times (vector-length v)
 (lambda (i) (vector-set! nv i (vector-ref v i))))
 nv)
 (define nm (make-vector (matrix-col-length m)))
 (times (vector-length nm)
 (lambda (i) (vector-set! nm i (vector-copy (vector-ref m i)))))
 nm)
;;;a row switched with another row
(define (matrix-row-switch! m i j)
 (let ((vi (vector-ref m (- i 1)))
 (vj (vector-ref m (- j 1))))
 (vector-set! m (- j 1) vi)
 (vector-set! m (- i 1) vj)))
;;;each element in a row multiplied by a non-zero constant
(define (matrix-row-multiply! m i k)
 (let ((v (vector-ref m (- i 1))))
 (times
 (matrix-row-length m)
 (lambda (n) (vector-set! v n (* (vector-ref v n) k))))))
;;;a row replaced by the sum of that row and a multiple of another row
(define (matrix-row-add! m i k j)
(let ((v (vector-ref m (- i 1)))
 (w (vector-ref m (- j 1))))
 (times
 (matrix-row-length m)
 (lambda (n)
 (vector-set! v n (+(vector-ref v n) (* (vector-ref w n) k)))))))
m2 ;=> #(#(0 0 0) #(3 0 0))
(matrix-row-switch! m2 1 2)
m2 ;=> #(#(3 0 0) #(0 0 0))
(matrix-row-multiply! m2 1 1/6)
m2 ;=> #(#(1/2 0 0) #(0 0 0))
(matrix-row-add! m2 2 4 1)
m2 ;=> #(#(1/2 0 0) #(2 0 0))

这些变换都是对矩阵的单row的数据的变动。

现在变换的目标是矩阵reduced row echelon form，即变换为简化行阶梯形矩阵：
1，每一个不是全为0的行的第一个非0项是1；
2，在这个非零项1的下方的列项全为0；
3，按照k+1行比k行的第一个非零项之前的0少，全为0的行放在非0行的下方的形式排列。
(http://zh.wikipedia.org/wiki/%E8%A1%8C%E6%A2%AF%E9%99%A3%E5%BC%8F)
这一变换过程称为高斯消元法，代码可以写为（省事一下，转个链接）：
http://www.math.grin.edu/~stone/events/scheme-workshop/gaussian.html
通过该算法，可以用来求线性方程的解矩阵的秩可逆方阵的逆矩阵以及对应行列式的值。

同时，矩阵的线性变换等价于一个初等矩阵与该矩阵的乘积。
于是这便引出了下面的内容，两个矩阵的乘法：
(define (matrix-multiply-can? m1 m2)
 (= (matrix-row-length m1) (matrix-col-length m2)))
(define (matrix-multiply m1 m2) ...)
这里的代码也请自行补脑吧，就先直接按照定义来，计算所生成的矩阵的每一个元素。
在Maxima的线性代数计算包里，有很多这方面的代码可以参考。

然后接着往下说，一不小心全篇的比例安排出了点问题，上面肥胖了：
计算a*b和b*c的两个矩阵相乘，直接计算需要a*b*c次数的乘法。
那么这是不是最少需要的乘法次数呢，对此回答是不是。
比如运用Strassen算法计算两个2*2矩阵乘法仅需要7次数的乘法而不是8次。

现在还是先看按照定义的矩阵乘法算法，情况变为对多个矩阵的运算。
比如计算三个矩阵的乘法，这三个矩阵分别是 A(50*20) B(20*1) C(1*10)。
注意，矩阵乘法是不满足交换率，但可以使用结合率的。
那么采用两种结合顺序所需的乘法次数分别为：
A*B计算50*20*1次得到一个50*1的矩阵D，再D*C共计算50*20*1+50*1*10=1500次，
B*C计算20*1*10次得到一个20*10的矩阵D，再A*D共计算20*1*10+50*20*10=10200次。
这两者计算需要的乘法次数相差是巨大的。
当有n的矩阵连成的时候，寻则合适的计算顺序对计算的时间消耗有巨大的影响。

那么现在的问题就是对于给定次数的一次矩阵，
如'((50 20) (20 1) (1 10) (1 100)) ,
在计算乘法的过程中最少需要进行多少次数的乘法运算呢？

记该矩阵序列的元素个数为n，则：
n=1时，不需要计算，A；
n=2时，计算是固定的A*B；
n=3时，计算有两种情况，(A*B)*C或A*(B*C)；
n=4时，计算有五种情况，A*(B*C*D)或(A*B)*(B*C)或(A*B*C)*D；
不过这里也可以作为三种情况看待，之后的情况类推。
也就是说对于n=k，最少只需要k-1种情况中选择出最优情况即可。
虽然这样也需要一定的计算量，但是已经和计算全部情况比要简单了。

我们这里的计算过程将以填充一个矩阵的形式来进行。
依然记该矩阵序列的元素个数为n，现在构建一个n*n的矩阵，下标i表示序列中的第i个元素，
[row,col]用来存放第row个到第col个矩阵所需要的计算次数，初始值为正无穷大。
现在的目的是填充矩阵中所有col>=row的元素：
首先所有满足row=col的元素填充为零，表示几个矩阵不需要计算。
然后填充所有满足col-row=1的元素为第row个和第col个矩阵相乘所需的次数，为一固定值。
接下来填充所有满足col-row=2的元素，有两种情况，填上其中的最小值。
再接下来重复类似的过程，对col-row=k即有k+1个元素的序列比较k种情况，填上其中的最小值。
这样进行，整个过程是由一个对角线开始填充起，填充往另一个对角。
要解决的问题[1,col]的情况，也就是整个序列，在我们的矩阵中最后被填充，位于右上角。

再具体点来说，对col-row=k格子对应的k种情况是[row,tmp]和[tmp+1,col]两个矩阵的乘法。
其中tmp可以的取值范围是[row,col-1]，在该区间内可以取到k个整数，它们都是填充需参考的数值。
也就是说在填充下标为[row,col]且col-row=k的格子时，需要满足col-row<k的格子已被填充。
并且填充这个格子的数值需要在tmp属于[row,col-1]的范围里，
也就是[row,tmp]和[tmp+1,col]两个矩阵的乘法中选择出最优的解来填充。
在填充过程中为了简化过程，可以把格子上填上已知的最小值，之后发现更优的值再做修改。
不过如果不直接填充确定的数值的话，要保证在推导这个数值时，它所依赖的数值已经是最优解了。

如果现在所给的矩阵序列的尺寸满足，最小数乘次数为(min-multiply row col)：
(define size-vector #((50 20) (20 1) (1 10) (1 100)))
(define (multiply size-vector row tmp col)
 (+ (min-multiply size-vector row tmp)
 (min-multiply (+ tmp 1) col)
 (* (car (vector-ref size-vector (- row 1)))
 (cdr (vector-ref size-vector (- tmp 1)))
 (cdr (vector-ref size-vector (- col 1))))))
(define (min-multiply size-vector row col)
 (if (= row col)
 0
 (apply min (map
 (lambda (i) (multiply size-vector row i col))
 (range row (- col 1))))))
这里min-multiply可以直接采用递归定义，不过出于效率将使用之前所填充的矩阵。
也就是对于每次调用min-multiply变为执行：
(matrix-set! mt row col (min-multiply size-vector row col))
并且在multiply中的min-multiply用matrix-ref来替代。

如果要做这样的修改的话，问题的思考又回到了先前所说的填充策略上来了。
因为要保证对矩阵某一元素在调用matrix-ref前已经执行过matrix-set!。
那么再具体些来看这个填充过程，第一个填上的格子是[1,1]，填上的数值是0。
接下可以给[2,2]填上1，然后填[1,2]，它依赖[1,1]和[2,2]的值。
如果下面填[1,3]的话，还需要[1,1][2,3]和[1,2][3,3]的值，其中只填好了[1,1]。

现在再回到上面说到的过的对填充过程的简化上来：
先填充所有row=col的格子，即[1,1],[2,2],[3,3]...
然后填[1,2]，没有问题，和先前一样。
再然后填[1,3]，这里用[1,2]和[3,3]的组合，不一定是最优解。
先不管，接着往下填。
此时[1,4]不能用[1,3][4,4]填，因为[1,3]的值不一定对。
那么就去填[2,3]，然后用[1,1][2,3]填回[1,3]。
此时[1,3]的值确定了，那么[1,4]又可以填一个不确定的值。
依次反复...这里代码再一次你省略...

运用类似的方法，可以解决另一个问题——最小编辑距离：
有两个字符序列，例如"cat"和"hatch"，记插入删除修改为一次操作。
那么问题是第一个序列需要多少次修改可以变为第二个序列。
那么我们先建立两个矩阵，row和col表示两个字符序列。
这里下标[2,2]即表示从"ca"到"ha"的修改次数，这里是1。
并且同样能判断[1,1]是"c"->"h"是1，[1,2]是"c"->"ha"是2，[2,1]是"ca"->"h"是2。
那么[2,2]即"ca"->"ha"的有三种修改方式：
1.和[1,1]次数相同，"ca"->"ha"；
2.比[1,2]多1次即3，"ca"->"c"->"ha"；
3.比[2,1]多1次即3，"ca"->"h"->"ha"；
其中除了第一种情况是次数相同或多一次，其他两种情况都是多增加一次。
最优次数便是这三种情况中最小的，然后接下来所要做的事情就和之前差不多了。

抽象的来看，整个问题的求解是在遍历一个无环有向图。
遍历的起点是矩阵中所有row=col的点，终点是所求的最终结果。
在若干点之间存在有向的箭头，图的最短路径即问题的最优解。

如果乘法序列中存在连续个相同的矩阵，又会出现别的有趣的情况。
如果A*X=r*X，那么r是A的特征值，X是A的对应r的特征向量。
此时A^n*X=r^n*X，当r可以求出来时，运算会变得很简单。

例如斐波那契数列数的计算，用矩阵的乘法可以表示为：
记A=2*2的矩阵，B为1*2的矩阵，计算A*B。
[1 1] [1] [2]
[1 0] [1] [1]
这里的2即是该数列的第三项。
那么第n项位于A^(n-2)*B。

A有特征值和特征向量：
-(sqrt(5)-1)/2对应[1,-(sqrt(5)+1)/2]
(sqrt(5)+1)/2对应[1,(sqrt(5)-1)/2]
借此可以得到斐波那契数数列的通项公式：
fib(n)=(1/sqrt(5))*(((1+sqrt(5))/2)^n-((1-sqrt(5))/2)^n)

再具体点来说的话，这里就暂且不继续说了...

* Scheme Toy #28 Heap
ee.zsy 2011年03月08日 16:14

这篇过度一下，内容简短一些，回顾一些之前写过的东西。
在计算机中，名词Data structure是指储存和组织数据的方式。
在Scheme语言中，最基本的用来组合基本类型的结构是Pair，它将一对引用变现为一个点对。

当Pair呈链状时，便成为了List列表。
用Pair的car指向数据，用Pair的cdr指向下一个列表中存放下一个元素的Piar。
直到一个Pair的cdr为努力了，便到了列表的最后一个元素，整个列表便结束了。

当一个储存单元可以依次存放多个元素时，便成为了Vector向量。
向量中能够放置的元素个数是在向量创建时固定的，之后以下标的方式存取。

这两种复合数据类型是可以嵌套使用的，比如List中Pair的cdr就指向另一个List。
而当List中有Pair的cdr也指向一个List时，可以看作List中存在元素类型也为List。
Vector和List之间是可以互相嵌套的，用一个Vector来存放List是很正常的事情。

如果要遍历一个List，通过正访问的Pair的cdr可以获得下一个元素，同时也是以下一个元素为首的子List。
如果要遍历一个Vector，通过正访问的元素的下标加一以访问下一个元素，和遍历List是的性能是同样的。
如果要遍历一个嵌套结构，通过访问一个元素时递归的使用遍历函数，除非该元素已经不是复合结构了。

List中的Pair通常作为不可变的类型使用，如果创建的新List是在原列表的头部增删元素的话，原List不用改变。
新增元素的作为一个新的Pair，在car中存放新增的数据，在cdr中指向原来的List即可。
如果第一个元素不再需要了，可以通过cdr获得第二个元素开始的子列表，而让废弃的元素被gc。
这种先进先出的结构称为Stack，并且以上的实现能够满足Push和Pop都有很好的效率。

不过如果想获得List第n个元素的话，就需要从头部依次往后找，需要线性的的查找时间。
而Vector结构基于下标的访问只需要常数的查找时间，并且不且不需要用额外的引用指向子List。
对于序列的结构，可以用Vector来实现。当已创建的Vector大小不够时可以重新创建，或建立Vector-pool。

对于不同的结构的使用，需要根据使用的情况来选择，更具所需操作的特点，并衡量空间和时间的要素。
对于固定的使用界面，底部的实现是可以替换的，这便是抽象和封装的好处，可以在实现复杂度运行效率和已有代码重用之间权衡。

因为Vector通常是以下标的方式使用元素，在存储操作中，通常都会使用有副作用的方式。
而List在子列表相同，也就是指建立新的cdr引用时，子列表是作为一个共享数据存在的。
其中要注意的是，有副作用的会影响所有使用到这个数据的数据，忽视这点会发生意料外的情况。
如果操作不能共享数据，出于Pair的特性或者使用者特定用途，会使得数据被复制，对于List和Vector都会。
当使用set-cdr!会使得List不再是Pair构成的二叉树结构，例如用cdr指向自身所在Pair便构成了循环结构。

当List的特性不满足当前所需要的操作时，可以建立相关的结果存放辅助的操作。
一个较简单的例子是Queue，它要求先进后出，所以存取操作会在List的两端进行。
List的特性使得它只要一端的操作是高效的，那么一种做法是用一个Pair来指向首尾元素。
并且在使用Queue时更新这个Pair。或者选择特定时候集中时间对已有元素进行一个逆置。

在另一些编程语言中，数组指针结构是作为基本的数据复合手段的。
和这里比较的话，数组对应于向量，指针对应于引用，实现上的差异暂且略过，从用法说的话是完全一致的。
并且由于Scheme是动态类型的，固定分配的向量可以以下标的方式存放不同类型的数据，结构可以看作一种下标的别名。
而ML系的语言，和List系的语言在数据结构上共用了很多概念，并且在静态类型之下，对数据的复合也有很好的表现。
这里想说的是，虽然不同的编程语言在在提供用于复合的类型上不完全相同，不过之间的思路还是一致的。

好了，闲话说完，现在回到此篇的主题上。
本篇要说的是Priority Queue，中文称之为优先列队，其特点是每次所取出的元素在列表中拥有最高的优先级。
例如可以创建一个数越大优先级越高的数列，在使用中可以存取操作，其中每次读取操作所获得的数是当前优先列队中最大的，
优先列队的实现方式是多样的，比如一个直观的想法是对列队中全部元素进行排序，尽管可能会有多余的排序操作。
如果读取途中不再需要插入操作，可以使用较常见的快速排序，而很少的插入操作可以使用插入排序的方式来。

对于通常的优先列队，其实现所要求的最基本的是，可以高效的获得优先级最高的元素，并且在插入元素之后依然可以。
对于这样的要求，最常用的简单的数据结果被称为Binary Heap，即满足节点优先级高于子节点的完全二叉树。
下面的内容将从Heap结果的存储以及对应的增删两种操作的实现来说明，定义make-heap、push-heap和pop-heap。

这里，完全二叉树树可以用数组来实现，跟节点位于数组首部，而插入的元素可以放在数组末尾。
对于下标为i的节点，记根节点编号为1，则左子节点编号为(2*i)，右节点编号为(2*i+1)，父节点的编号是floor(i/2)。
对于Push操作，数组末尾的节点是叶节点，为了满足bh的限定，将和它的父节点比较，把优先级高的节点移向根部。
对于pop，即获得优先级最高的节点，需要取走根节点，并用数组的最后一个元素填补该空缺，然后把它于子节点比较。
这一过程的目的是在对该表现BH的数组在插入或或许元素之后，该数组依然能够满足BH的的结构。

在Heap结构中，节点的大小关系仅在父节点与它的子节点之间，子节点之间并没有大小要求，因为这不影响根节点是最值。
并且二叉树是heap结构中最简单的一种情况，出于性能的优化，可以n个节点，或者以某个序列的形式来排列子节点数。

以下是一个参考实现，当前仅保证结果正确，实现上明显的欠缺将作为之后改进的内容。
(define (empty-heap) '())
(define (list-swap! x i j)
 (define (pair-swap! x y)
 (let ((m (car x))
 (n (car y)))
 (set-car! x n)
 (set-car! y m))
 #t)
 (let ((a (list-tail x i))
 (b (list-tail x j)))
 (pair-swap! a b)))
(define (list-length x)
 (if (null? x)
 0
 (+ 1 (list-length (cdr x)))))
(define (heap-father i)
 (- (floor (/ (+ 1 i) 2)) 1))
(define (heap-children i)
 (let ((t (* 2 (+ 1 i))))
 (list (- t 1) t)))
(define (bubble-up t father child)
 (if (< (list-ref t father) (list-ref t child))
 (list-swap! father child)
 #f))
(define (sift-down! t father . children)
 (call-with-current-continuation
 (lambda (return)
 (map (lambda (child)
 (if (< (list-ref father) (list-ref child))
 (begin
 (list-swap! father child)
 (return child))))
 children)
 #f)))
(define (push-heap! x a) ... )
(define (pop-heap! x i) ...)

因为时间有限，这里列出的实现还不完整，不过已经能够用来演示大体的思路了。
这里元素的下标是从零开始计数的，不过这和提供出来的Heap的界面没有关系。
这里暂且最大数为最高优先级了，以后可用通过增加参数的形式传入比较用的函数。
虽然Scheme鼓励没有副作用，不过若每次移动节点都重新生成一颗树的话，未免浪费了。

下面来说说Heap的其他方面，比如Heapsort便是利用Heap结构优先列队的特性，进行插入排序的一种排序算法。
而Treap是满足Heap特定的二叉搜索树，在插入和删除过程中使用了二叉搜索并在调整节点时旋转整个子树。
Treap是利用随机算法保证得到的树是尽可能平衡的，而在实现上比通常所用的红黑树要简单。

后面如果说到一些最优化问题的话，还是会再把优先列队作为一种基本的类型拿出来使用的。

以下链接是某本教材中的全部演示代码，比我这里列出的东西要完整许多，供参考。
http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/scheme/edu/tut/0.html

* Scheme Toy #29 Maze
ee.zsy 2011年03月15日 21:22

Maze就是迷宫，一种解谜游戏，在支路中寻找到出口。
如果沿着一侧的墙走的话，是肯定会走到出口的。
下面要说的问题就是关于找迷宫出口的，不过仅来说说纸面上的迷宫。

首先来画一个迷宫吧：
(define m "
*##########
**#***#***#
#***#***###
##*#*##***#
##***##*#*#
#*##****###
#****##***#
#########**
")
用artist-mode画的迷宫图，存在一个字符串中。
图中#表示墙，*表示通路，左上角是入口，右下角是出口。

首先来看一下迷宫图的尺寸：
(define (maze-size m)
 (let* ((w (do ((i 1 (+ i 1)))
 ((char=? (string-ref m i) #\newline) (- i 1))))
 (h (let loop ((i w) (h 0))
 (if (= i (string-length m))
 h
 (loop (+ i 1) (if (char=? (string-ref m i) #\newline) (+ h 1) h))))))
 (list w h)))
(maze-size m) ;=>(11 8)
暂时为了简单，要求提供图的字符串开头结尾和换行都必须是且只能是\n。
容错或检测什么可以再加，或者转换为二维向量会简化接下来处理。
这些修改都不影响目前的接口，改变实现只好还是提供同样的函数调用。

可以看到整个迷宫图，就由下标来判断某点是否能通过吧。记左上角为(0,0)：
(define (maze-pass? m x y)
 (let* ((size (maze-size m))
 (i (+ 1 x (* (+ (car size) 1) y))))
 (char=? (string-ref m i) #\*)))

至此准备工作结束，我们所能获得信息就来源于这两个过程。

于是下面进入正文，开始走迷宫。要求经过可通行区域，从左上角到右下角。

来用一个简单的例子：
*######
*#***##
***#*##
##****#
#**##*#
#####**

给所有的端点和交点做上编号：
A######
*#***##
**B#*##
##C*D*#
#E*##*#
#####*F
这步也可以一起完成。

于是得到了一个无向循环图：
(define g '((A B C D E F) ((A B) (B C) (B D) (C D) (C E) (D F))))

执行深度优先搜索的话可以得到：
(define (dfs graph src des)
 (define (neighbors node)
 (let iter ((i (cadr graph)))
 (cond
 ((null? i) '())
 ((eq? (caar i) node)
 (cons (cadar i) (iter (cdr i))))
 ((eq? (cadar i) node)
 (cons (caar i) (iter (cdr i))))
 (else
 (iter (cdr i))))))
 (define (try path)
 (define (try_node node path)
 (cond
 ((eq? node src)
 (list (cons node path)))
 ((not (member node path))
 ;;not-visited?
 (try (cons node path)))
 (else '())))
 (apply
 append
 (filter
 (lambda (i) (not (null? i)))
 (map
 (lambda (node) (try_node node path))
 (neighbors (car path)))))
 )
 (try (list des))
 )
(dfs g 'A 'F)
;=> ((A B D F) (A B C D F))
搜索到了两条可行的路径。
其中filter块也可写为：
(do ((i (neighbors (car path)) (cdr i))
 (l '() (let ((t (try_node (car i) path))) (if (null? t) l (cons t l)) )))
 ((null? i) l))

这一搜索过程可以尾递归用Stack来表示：
;(require SRFI/1)
(define g '((A B C D E F) ((A B) (B C) (B D) (C D) (C E) (D F))))
(define (neighbors graph node)
 (let iter ((i (cadr graph)))
 (cond
 ((null? i) '())
 ((eq? (caar i) node)
 (cons (cadar i) (iter (cdr i))))
 ((eq? (cadar i) node)
 (cons (caar i) (iter (cdr i))))
 (else
 (iter (cdr i))))))
(define (make) '())
(define (push stack atom)
 (cons atom stack))
(define (push-list stack list)
 (append list stack))
(define (pop stack)
 (cdr stack))
(define (top stack)
 (car stack))
(define (empty? stack)
 (null? stack))
(define (dfs graph src des)
 (define (try path-stack)
 (display path-stack)
 (newline)
 (define (try_node node path)
 (if (member node path)
 '()
 (cons node path)))
 (cond
 ((empty? path-stack)
 '())
 ((null? (top path-stack))
 (try (pop path-stack)))
 ((eq? (car (top path-stack)) src)
 (cons (top path-stack) (try (pop path-stack))))
 (else
 (try (push-list
 (pop path-stack)
 (map
 (lambda (i) (try_node i (top path-stack)))
 (neighbors graph (car (top path-stack)))))))))
 (try (push (make) (list des)))
 )
(dfs g 'A 'F)
;=> ((A B D F) (A B C D F))
结果是一致的。

下面把Stack换成Queue结构：
(define (make) '())
(define (push queue atom)
 (append queue atom))
(define (push-list queue list)
 (append queue list))
(define (pop queue)
 (cdr queue))
(define (top queue)
 (car queue))
(define (empty? queue)
 (null? queue))
代入上面的代码目前所得到的结果仍然一致。
变化之处在于此时搜索已经变为广度优先搜索了，
(cons (top path-stack) (try (pop path-stack)))一行可以改为：
(top path-stack)
或者(cons (top path-stack) (delay (try (pop path-stack))))
来仅获得需要的结果。
如果要限定搜索的深度，也在这一步上修改。

再换成PriorityQueue也是可行的：
(define (make) '())
(define (push priority-queue atom <)
 (if (< (car priority-queue) atom)
 (cons (car priority-queue) (push (cdr priority-queue) atom <) )
 (cons atom priority-queue)))
(define (push-list priority-queue list <)
 (fold (lambda (a pq) (push pq a <)) priority-queue list))
对于优先列队，在迷宫图中可以用离起点已走距离加离终点直线距离的和作为优先级。

这里替换搜索用的结构的目的是找到最优的路径。
不过上面那个Queue得到第一个结果是经历节点最少的路径，
而通常意义上对最优路径的理解是行走路程最短的路径。

现在的做法是改变标记原迷宫图的方法，
不仅仅标记交点和端点，而标记所有可通行的点。
现在通过节点最少的路径就等于路程最少的路径了，
上面基于Queue的Search算法的首结果就满足最优解了。

因为原迷宫图是个矩阵（二维向量），可以不同符号而用点对来标记点：
左上角起点为'(0 . 0)，右下角终点在这个例子里是'(6 . 5)。
这次不写要用到的标记代码了，直接修改neighbors过程。
该过程的作用不变，返回图中与某节点相邻的可通行的节点。
这里也就是返回上下左右四个方向在迷宫区域内可通行的节点的点对列表。

这里对应的如果使用优先列队的话，具体的说就是：
这里所push的atom代表一个path，其长度代表已走过的距离。
节点到终点的估计距离用平面几何的勾股定理可求。
这两个距离之和代表该节点的优先级，和越小优先级越高。
下一个节点按照同样的方法继续处理，直到抵达目标节点。
这种搜索方式称为A*搜索。

这样的修改依然是在使用无向循环图，更直接的模型是带权的无向循环图：
(define g '((A B C D E F) ((A B 3) (B C 1) (B D 5) (C D 2) (C E 2) (D F 4))))
这里为每条边标记上额外的数值属性表示两点间的距离。
上面标记所有节点的做法当把图放大n倍时，搜索路径会相当巨大。

接下来的目的仍然是搜索最短路径，
所要做的修改是让经过路程最短的节点具有做高优先级。
虽然实现的效率略差，这和Dijkstra算法的原理是一致的。
当不需要路径而仅要最优的数值时，可只保存一个每点到其访问状态的映射关系。
http://upload.wikimedia.org/wikipedia/commons/4/45/Dijksta_Anim.gif

当问题是DAG，也就是无方向无环路的情况下，问题要简单很多：
(define (node value . subnodes) (cons value subnodes))
(define (value node) (car node))
(define (subnodes node) (cdr node))
(define (leaf? node) (null? (subnodes node)))
(define (dft tree) (cons (value tree) (apply append (map dft (subnodes tree)))))
(define (bft tree) (cons (value tree) (if (leaf? tree) '() (bft (apply node (value (car (subnodes tree))) (append (subnodes (subnodes tree)) (subnodes (car (subnodes tree)))))))))
(define tree (node 1 (node 2 (node 4)) (node 3 (node 6) (node 7)) (node 5)))
(dft tree) ;=>(1 2 4 3 6 7 5)
(bft tree) ;=>(1 2 3 6 7 5 4)

如果使用ML的抽象数据类型ADT加强静态类型的话，要看起来比单纯的动态类型清晰严谨：
type tree=
 | Empty
 | Leaf of int
 | Node of int*tree list
let rec dft t=match t with
 | Empty -> []
 | Leaf i -> [i]
 | Node (i,l) -> i::List.concat (List.map dft l)
let bft (t:tree)=
 let rec inbft (queue:tree list)=match queue with
 | [] -> []
 | Empty::tl -> []
 | Leaf i::tl -> i::(inbft tl)
 | Node (i,l)::tl ->i::(inbft (tl@l))
 in inbft (t::[])
;;
let t1=Node(1,[Node(2,[Leaf 4]);Node(3,[Leaf 6;Leaf 7]);Leaf 5])
let _ =List.map print_int (dft t1)
(* 1243675 *)
let _ =List.map print_int (bft t1)
(* 1235467 *)
虽然说类型正确并不能保证语义正确，这里的列队效率不好。
语义可用数学归纳法证明，列队可以引入副作用或改为两个列表来回逆置。

前面的有个图可以这样表示为：
type node=A|B|C|D|E|F|G
type edge=Ed of node*node
type graph=G of node list*edge list
let g=G([A;B;C;D;E;F],
 [Ed(A,B);Ed(B,C);Ed(B,D);Ed(C,D);Ed(C,E);Ed(D,F)])

其他的搜索方式也可以按照类似的方式改写。

* Scheme Toy #29.5 NetworkFlow
ee.zsy 2011年03月23日 14:01

线性规划问题是一种最优化问题，例如求一定条件下最大收益最小收益什么的。
它是在一组线性约束条件下（可以表示为一个矩阵）求一个线性目标函数的最值。

线性规划的问题可以从解析几何的角度求求解：
约束条件代表空间里的区域，目标函数是空间里的一组曲线，其中可能存在最优的情况。
常用的算法是Simplex，具有指数级的算法复杂度。

在图论中一种较简单的线性规划问题是NetworkFlow模型的最大流问题，它是求每边有容量性质的有向图中流量最大的情况。
这个问题也等价于求将网络流模型分割成两部分后，两区域间流量最少的分割情况，因为它就是限制最大流的要素。

来做一点准备活动，首先拿出一个如下的网络流模型：
(define nf '((s o p q r t )((s o 3)(s p 3)(o p 2)(o q 3)(p r 2)(r t 3)(q r 4)(q t 2))))
其中的边是有向的，边上的数值代表流容量。

然后把前一篇的迷宫搜索问题的代码拿过来，得到所有s到t的路径：
(define paths (bfs nf 's 't)) ;=>
((s p r t) (s o q t) (s o p r t) (s o q r t) (s p o q t) (s p r q t) (s p o q r t) (s o p r q t))

然后定义表示图中一个箭头的流量的过程：
(define (capacity nf from to)
 (let iter ((i (cadr nf)))
 (cond
 ((null? i) 0)
 ((and (eq? (caar i) from) (eq? (cadar i) to))
 (caddar i))
 ((and (eq? (caar i) to) (eq? (cadar i) from))
 (- (caddar i)))
 (else
 (iter (cdr i))))))
这里反向路径得到的是负值。

现在就可以用Ford–Fulkerson算法，通过增加每条路径的流量，来求最大流了。
通过选择合适的路径迭代路径，可以减少迭代的次数，例如可以以结点数递增的顺序：
(define (maximum-flow nf paths)
 (define curr
 (apply append (map (lambda (i) `(((,(car i) ,(cadr i)) . 0))) (cadr nf))))
 (define (set-flow-of-edge! p v)
 (cond
 ((assoc p curr)
 => (lambda (i) (set-cdr! i (+ v (flow-of-curr-edge p)))))
 ((assoc (list (cadr p) (car p)) curr)
 => (lambda (i) (set-cdr! i (- (flow-of-curr-edge (car i)) v))))
 (else #f)))
 (define (flow-of-curr-edge p)
 (cond
 ((assoc p curr) => (lambda (i) (cdr i)))
 ((assoc (list (cadr p) (car p)) curr) => (lambda (i) (- (cdr i))))
 (else #f)))
 (define (capacity-of-point p) (capacity nf (car p) (cadr p)))
 (define (path->pairlist l)
 (let iter ((i l))
 (if (null? (cdr i))
 '()
 (cons (list (car i) (cadr i)) (iter (cdr i))))))
 (let iter ((p paths)(ch #f))
 (if (null? p)
 (if ch
 (iter (paths))
 (apply + (map (lambda (i) (if (eq? (cadar i) 't) (cdr i) 0)) curr)))
 (let* ((a (map (lambda (i) (capacity-of-point i)) (path->pairlist (car p))))
 (b (map (lambda (i) (flow-of-curr-edge i)) (path->pairlist (car p))))
 (c (apply min (map (lambda (x y) (if (> x 0) (- x y) (- y))) a b))))
 (display (car p)) (display a) (display b) (display c) (newline)
 (map (lambda (i) (set-flow-of-edge! i c)) (path->pairlist (car p)))
 (iter (cdr p) (and ch (> c 0)))))))
(maximum-flow nf paths)
;=> 5

当每条边上有不同的成本时，问题就是Minimum Cost Flow，求特定流量时的最小花费，同属于线性规划问题。

有些问题可以使用网络流模型来表达，转化为求最大流等问题，例如Bipartite Matching。
并且它在不影响结果时简化模型，将起点或汇点链接到单独的点上，从而求出最大匹配的情况。

* Scheme Toy #30 Reversi
ee.zsy 2011年03月23日 14:19

黑白棋也叫Reversi也叫Othello，说明见：
http://en.wikipedia.org/wiki/Reversi/Othello

这里演示的是如何让计算机和人类之间进行棋局的对弈。

下面是用了最基础的Minimax算法，并在实现上使用了NegMax和AlphaBeta。
原理是假设对手会进行最好的着棋，并自己走n步后情况最好的一种走法。
对棋面的判断是通过一个评估函数给出得分，不过当前评估准则的不大可靠。
可以的改进方法是加入随机算法评估时引入机器学习并用多线程搜索，这里还没有做到那一步。

以下全部代码+注释，目前棋力尚可，不过操作界面还不友善：
;#lang R5RS
;gsc -exe -cc-options "-O2 -s" ai.scm
;;;******** 选项部分 ************
(define search-level 5) ;int 推荐值3 or 5 or 6
;;;******** 使用R5RS **********
(define (debug . x) (for-each display (cons "|Debug>" x))(newline))
;(define (debug . x) 0)
(define (filter pred seq)
 (cond ((null? seq) '())
 ((pred (car seq))
 (cons (car seq)
 (filter pred (cdr seq))))
 (else (filter pred (cdr seq)))))
;;;******************** Game AI ********************
;;;******* 黑白棋 ****************** by ee.zsy ******
;;;****************** Mar. 2011 ********************
;;;*************************************************
;;;********** 以下是一些基础组件，可以单独测试 *********
;;;*************************************************
;;;新建棋盘
(define (make-board)
 '(((4 4) (5 5)) ((4 5) (5 4))))
;;;某偏移点的坐标
(define (next-p point v)
 (let ((x (+ (car point) (car v)))
 (y (+ (cadr point) (cadr v))))
 (if (or (zero? x) (zero? y) (> x 8) (> y 8))
 #f
 (list x y))))
;;;八方向
(define 8v '((-1 -1) (-1 1) (1 1) (1 -1) (-1 0) (1 0) (0 -1) (0 1)))
;;;序列
(define (1..8) '(1 2 3 4 5 6 7 8))
;;;以下都是假设player-1行动
;;;检查自己某点可否行动,返回需要翻转的对方棋子列表
(define (check point board)
 (define (try_v v)
 (let iter ((p (next-p point v)) (ap '()))
 (cond
 ;;出棋盘了
 ((not p) '())
 ;;有自己的棋子,返回路过的对方棋子
 ((member p (car board)) ap)
 ;;有对方的棋子,就记录下来
 ((member p (cadr board)) (iter (next-p p v) (cons p ap)))
 ;;没有棋子
 (else '()))))
 (if (or (member point (car board)) (member point (cadr board)))
 '()
 (apply append (map try_v 8v))))
;;;查询所以自己可以走的点
(define (put-where board)
 (define (try_p x y)
 (if (null? (check (list x y) board))
 '()
 (list (list x y))))
 ;;尝试所有的点
 (apply append (apply append (map (lambda (i) (map (lambda (j) (try_p i j)) (1..8))) (1..8)))))
;;;自己往棋盘上放棋子，请确保该点可放
(define (put-here point board)
 (let ((f (check point board)))
 (list
 (append (list point) f (car board))
 (filter (lambda (p) (not (member p f))) (cadr board)))))
;;;交换敌我
(define (swap-board board) (list (cadr board) (car board)))
;;;是否棋盘已满，棋局结束？
(define (end-board? board)
 (or (zero? (length (car board)))
 (zero? (length (cadr board)))
 (= 64 (+ (length (car board)) (length (cadr board))))));还有都不能放置的情况没写
;;;显示棋盘
(define (show-board board)
 (define (show_p x y)
 (cond ((member (list x y) (car board)) "O")
 ((member (list x y) (cadr board)) "X")
 (else "+")))
 (newline) (display "* BOARD *")
 (newline) (display " ")(for-each display (1..8)) (newline)
 (for-each
 (lambda (i)
 (display i)
 (for-each
 (lambda (j)(display (show_p i j)))
 (1..8)) (newline))
 (1..8)))
;;;*************************************
;;;*** 棋子相关结束，AI部分开始 ***********
;;;*************************************
;;;评估棋面，重要，关系到AI的判断!
(define (eval-board board)
 (+ 0
 (length (car board))
 (- (length (cadr board)))
 (if (member '(1 1) (car board)) 48 0)
 (if (member '(1 8) (car board)) 48 0)
 (if (member '(8 1) (car board)) 48 0)
 (if (member '(8 8) (car board)) 48 0)
 ; (if (or
 ; (member '(1 1) (car board))
 ; (member '(1 8) (car board))
 ; (member '(8 1) (car board))
 ; (member '(8 8) (car board))
 ; ) 100 0)
 ))
;;;智能搜索过程!这是最终可用的版本!
;;;先前版本已删除，这里是迭代开发模式，接口不变。
(define (pick_blist2 board)
 ;;返回放置后的棋盘
 (define (next-boards board);;走棋后的所有棋盘
 (let ((blists (map (lambda (i) (put-here i board)) (put-where board))))
 ;;(debug "可选行动" blists)
 (if (null? blists)
 (list board)
 blists)))
 (define (try_board2 board level do alpha);这是带剪枝版本！
 ;;递归调用，返回'(评估值行动后盘面)
 (if (or (end-board? board) (> level search-level));搜索终止,则评估局面,否则再往下层搜索。
 (list (let ((e (eval-board board))) e) do)
 ((lambda (i) (cons (- (car i)) (cdr i)))
 (let iter ((lists (next-boards (swap-board board))) (max-board '(-65535 ())))
 ;;依次搜索每一个可能的走法
 (if (null? lists)
 max-board
 (let* ((i (car lists))
 (item (try_board2 i (+ level 1) (if (zero? level) i do) (car max-board))))
 (if (< (- (car item)) alpha);如果可以剪枝的话，就Cut！不改变结果，但很提升性能
 item
 (iter (cdr lists) (if (>= (car max-board) (car item)) max-board item)))))))))
 (let ((i (try_board2 (swap-board board) 0 '() -65535)))
 (display (car i))
 (cadr i)))
;;;对手（AI）进行行动，供其他模块调用
(define (other-do board) (swap-board (pick_blist2 (swap-board board))))
;;;********* 基础部分结束 ****************
;;;*************************************
;;;******** 下面是交互部分 ***************
(define (main)
 (define (read-choice n)
 (if #f
 1
 (if (zero? n)
 #f
 (begin
 (display "请输入1..")
 (display n)
 (display "的数值：\n")
 (let ((r (read)))
 (if (and (integer? r) (> r 0) (<= r n))
 r
 (read-choice n)))))))
 (define (win? board)
 (> (length (car board)) (length (cadr board))))
 (define board (make-board))
 ;(set! board '(((2 3) (3 5) (4 5) (5 5)) ((2 4) (3 4) (4 4) (5 4))))
 ;测试用棋面状态
 (newline)
 (display "* 黑白棋 *\n")
 ;;call/cc+loop==while+break
 (call-with-current-continuation
 (lambda (break)
 (let loop ()
 (display "\n当前棋盘是：");(display board)
 (map display (list "\n局面："(length (car board)) "-" (length (cadr board))))
 (show-board board)
 (display "请选择你的行动：\n")
 (let ((nexts (list->vector (put-where board))))
 ;(display nexts)
 (do ((i 0 (+ i 1)))
 ((= i (vector-length nexts)))
 (for-each display (list (+ i 1) ":" (vector-ref nexts i) " ")))
 (newline)
 (let* ((a (vector-length nexts))
 (c (if (zero? a) #f (read-choice a))))
 (if c
 (set! board (put-here (vector-ref nexts (- c 1)) board))
 '())))
 (if (end-board? board) (break) '())
 (show-board board)
 (display "AI思考中……")
 (set! board (other-do board))
 ;(display (pick_blist2 board))
 (if (end-board? board) (break) '())
 (loop))))
 (display "\n棋盘结束")
 (show-board board)
 (map display (list "\n棋局结果是:"(length (car board)) "-" (length (cadr board)) "\n"))
 (display (if (win? board) "You Win" "AI Win"));还有平局情况
 (read)
 )
;;;*************************************
;;;测试用代码区域
;(define b (make-board))
;(newline)
;(display (check '(3 5) b))
;(display (put-where b))
;(newline)
;(display "***************")
;(show-board (put-here '(4 6) b))
;(display (eval-board (put-here '(4 6) b)))
;(display (put-where (put-here '(4 6) b)))
;;can-put-1?
;(newline)
;;(display (pick_blist1 b))
(display "说明")
(main)

* Scheme Toy #32 IO
ee.zsy 2011年04月02日 19:30

IO是Input/Output的缩写，是输入输出的意思。
文件读写就是一种IO操作，屏幕可以看作一中特殊的文件，IO操作是有副作用的。

在Scheme中屏幕或者文件系统中的文件，这些IO设备都是Port对象。
Port分为input-port和output-port，并用current-*-port表示当前的port（初始表示屏幕）。
如果要使用文件的话，用open-*-file和close-*-port来打开和关闭port。
通常是用call-with-*-file来使用，接收以port为参数lambda表达式为参数，而不用手工打开关闭文件。
前面常用的在屏幕上显示信息的display和newline都可以以port作为参数。
还有with-input-from-file和with-output-to-file会改变它调用的thunk的默认port。

下面来说如何进行IO操作，R5RS提供了read-char，peek-char，eof-object?，char-ready?。
例如读入整个文件到字符串可以这样做：
(define (file->string filename)
 (call-with-input-file filename
 (lambda (p)
 (let loop ((l '()) (c (read-char p)))
 (if (eof-object? c)
 (list->string (reverse l))
 (loop (cons c l) (read-char p)))))))
在R6RS中还提供了相关的异常处理编码和数据流的处理这些在Java中熟悉的东西。

继续回到R5RS，还有read和write没说，下面来说。
read可以用上面已有的过程来实现，它是一个可以接受Scheme词法（s表达式）子集的parser过程。
而对应的write则正好按照read可读的方式来写，通常写文件时是用不到的。
例如把Scheme代码读入list可以这样做：
(define (scheme-file->list filename)
 (call-with-input-file filename
 (lambda (p)
 (let loop ((l '()) (s (read p)))
 (if (eof-object? s)
 (reverse l)
 (loop (cons s l) (read p)))))))
对着list进行eval操作的话，就等于解释器执行一个scm脚本。
同样的原因，REPL可以表达为：
(define (repl)
 (define env (scheme-report-environment 5))
 (let loop ((s (read)))
 (display (eval s env))
 (newline)
 (loop (read))))

这里read所接受的数据词法完整的在R5RS中是：
7.1.2 External representations
http://people.csail.mit.edu/jaffer/r5rs_9.html
可以把它改写为lex/yacc可接受的格式来实现这个Parser。
简略的说就是在.y文件中定义Token组成的EBNF，然后在.l中定义正则表达式返回的Token。
此时.l使用.y生成的头文件，.y使用.l生成的.c，然后我就可以用.y生成的.c文件提供的函数来解析输入流了。
虽然EBNF的表达能力包含了正则表达式的能力，不过把词法部分用正则表达式来写会更直观一些。
不过不论怎么说，还是减轻了手写的负担，况且LALR(1)的转移表的形式并不像LL(1)有递归下降那样较简单的形式。

如果仅仅考虑最简单前缀表达式的话，可以手写成这样的递归下降的解析器：
(define stdin (open-input-string "(+ 1 (* 22 333 ) 4444) 55555 666666"))
(define (read-sexp port)
 (define (read-id)
 (let loop ((id '()))
 (let ((next-char (peek-char port)))
 (cond
 ((and (not (null? id)) (eof-object? (car id))) 'eof)
 ((equal? id '(#\()) 'lp)
 ((equal? id '(#\))) 'rp)
 ((and (null? id) (char? next-char) (char-whitespace? next-char))
 (read-char port) (loop '()))
 ((and (not (null? id))
 (or
 (eof-object? next-char)
 (member next-char '(#\space #\( #\) #\" #\# #\newline))))
 (list->string id))
 (else (loop (append id (list (read-char port)))))))))
 (define (read-token)
 (define id (read-id))
 (if (string? id)
 (let ((n (string->number id)))
 (if n n (string->symbol id)))
 id))
 (define (read-list)
 (let loop ((token-list '()))
 (let ((i (read-exp)))
 (case i
 ((rp eof) token-list)
 (else (loop (append token-list (list i))))))))
 (define (read-exp)
 (let ((t (read-token)))
 (case t
 ((lp) (read-list))
 (else t))))
 (read-exp))
(define (read-stmts port)
 (let loop ((s '()) (e (read-sexp port)))
 (if (eq? e 'eof)
 s
 (loop (append s (list e)) (read-sexp port)))))
(read-sexp stdin) ;=> (+ 1 (* 22 333) 4444)
(read-stmts stdin) ;=> (55555 666666)

解析Sexp只需要预读一位，则更好的写法是把read-id写为：
(define (read-id)
 (define (read-sym sym)
 (display sym)
 (if (or
 (eof-object? (peek-char port))
 (member (peek-char port) '(#\space #\( #\) #\" #\# #\newline)))
 (list->string sym)
 (read-sym (append sym (list (read-char port))))))
 (let loop ()
 (let ((c (read-char port)))
 (cond
 ((eof-object? c) 'eof)
 ((eq? c #\() 'lp)
 ((eq? c #\)) 'rp)
 ((and (char? c) (char-whitespace? c)) (loop))
 (else (read-sym (list c)))))))
并把原先read-token中的识别格式的代码重构到read-sym里面去。

这里为了过程的清晰把read分解为read-token和read-sexp两个步骤。
定义type token=Eof | Tlp | Trp | Tint of int | Tsym of string | Tlist of token list;;
则其中read-token是 string -> token list 的过程。
定义type stree=Snode of token | Slist of stree list
则其中read-sexp是 token list -> stree 的过程。
这样便把string变为平坦的列表，再变为语言的树状结构。
需要进一步完善的话这里还没识别有引号，它代表字符串。
还有 #\ #( ' ` , ,@ 这些可以看作预处理的一部分的符号。
接下来可以实现对应的eval过程进行运算，或者替换解析的语法为其他的形式。

完整的实现见r6rs所给的参考代码中的Reader库，同是递归下降的形式：
http://www.r6rs.org/refimpl/r6rs-reader.tar.gz

* Scheme Toy #32.5 Reader
ee.zsy 2011年04月06日 21:54

整数四则运算表达式的解析和运算，是词法解析和语法解析的例子中最简单的一种情况。
下面是一个手写的递归下降的解析器，可以计算整数四则运算表达式的值，LL(1)文法都可以用这样的形式解析。
LL(1)文法是一种规则解析时由上到下由左至右每次预读一位进行判断下不会产生歧义的文法。
在下面的这段代码中，有calc-exp过程会对read-token识别的数据进行解析和运算，细节将在后面的文字里说明。

(define stdin (open-input-string "1+(44/2)*-3"))
(define *token* '())
(define (calc port)
 (define (peek-token)
 (if (null? *token*)
 (read-token)
 *token*))
 (define (read-token)
 (define (char->num c)
 (- (char->integer c) (char->integer #\0)))
 (define (read-num num)
 (if (and (char? (peek-char port)) (char-numeric? (peek-char port)))
 (read-num (+ (* 10 num) (char->num (read-char port))))
 num))
 (let ((token *token*))
 (set!
 *token*
 (let loop ()
 (let ((c (read-char port)))
 (cond
 ((eof-object? c) 'eof)
 ((eq? c #\() 'lp)
 ((eq? c #\)) 'rp)
 ((eq? c #\+) 'add)
 ((eq? c #\-) 'sub)
 ((eq? c #\*) 'mul)
 ((eq? c #\/) 'div)
 ((and (char? c) (char-whitespace? c)) (loop))
 ((and (char? c) (char-numeric? c)) (read-num (char->num c)))
 (else (display c) (error " not expected"))))))
 (if (null? token)
 (read-token)
 token )))
 (define (match t)
 (if (eq? t (read-token))
 #t
 (begin (display t) (error " needed"))))
 (define (calc-exp)
 (let loop ((t1 (calc-term)))
 (let ((t2 (peek-token)))
 (cond
 ((eq? t2 'add) (match 'add) (loop (+ t1 (calc-term))))
 ((eq? t2 'sub) (match 'sub) (loop (- t1 (calc-term))))
 (else t1)))))
 (define (calc-term)
 (let loop ((t1 (calc-factor)))
 (let ((t2 (peek-token)))
 (cond
 ((eq? t2 'mul) (match 'mul) (loop (* t1 (calc-factor))))
 ((eq? t2 'div) (match 'div) (loop (/ t1 (calc-factor))))
 (else t1)))))
 (define (calc-factor)
 (let ((t1 (read-token)))
 (cond
 ((eq? t1 'lp) (let (( v (calc-exp))) (match 'rp) v))
 ((number? t1) t1)
 ((eq? t1 'sub) (- (calc-factor)))
 (else (display "( or num ") (error "needed")))))
 (calc-exp))
(calc stdin) ;=> -65

首先要说明的是，被解析的数据来自于IO。读取IO是一个有副作用的过程，所以整个解析过程是伴随着IO的状态变化进行的。
那么来看整个解析过程，为了使整个过程描述的简单，这里分为了词法解析和语法解析部分，因为它们可以不同的方式实现。
因为语法解析部分的处理能力涵盖了词法解析部分的处理能了，出于结构的简化，这里只让词法部分于IO接触，然后语法部分只调用词法部分提供的过程。

上面的read-token过程，也就是词法解析过程，具有识别正则文法的能力。
该文法所对应的计算模型是有限自动状态机，出于简化，这里实现为确定有限状态自动机。
具体的说就是，该解析过程读取一个字符之后会转移到一个确定的状态，可以是中间状态或者捕获状态。
在Scheme对应的用来表示状态的转移的实现方式是转移表或者尾递归。
上面的例子中便是用尾递归从read-token转移到read-num再以不同的方式对待下一个字符。
由于正则文法可以用正则表达式表示，所以这样的解析过程可以通过整个表达式来自动生成。

上面的calc-exp过程，便是这里的语法解析过程，是一个递归下降的语法解析器。
它使用peek-token预读一位词法的解析结果，将EBNF可以书写的规则直接实现为对应的一组相互调用的递归过程。
该解析过程可以用一个下推自动机来描述，它和有限状态自动机相比增加了一个长度不受限制的栈，是状态转移过程中额外要参考的状态。
通过递归下降的解析方式，可以解析上下文无关语言的一个子集，而四则运算表达式正属于这个能被处理的集合。

出于简化考虑，可以用lex & yacc来生成词法和语法解析器，并且yacc生成的LARA(1)自下而上的解析器能处理LL(1)会有歧义的部分文法。

下面再做一点最简单的修改，让语法解析不再直接计算，而是生成语法树。
这里利用了Scheme的一些很方便的特性，只需要添加几处quasiquote和unquote就可以了：
(define (calc-exp)
 (let loop ((t1 (calc-term)))
 (let ((t2 (peek-token)))
 (cond
 ((eq? t2 'add) (match 'add) (loop `(+ ,t1 ,(calc-term))))
 ((eq? t2 'sub) (match 'sub) (loop `(- ,t1 ,(calc-term))))
 (else t1)))))
(define (calc-term)
 (let loop ((t1 (calc-factor)))
 (let ((t2 (peek-token)))
 (cond
 ((eq? t2 'mul) (match 'mul) (loop `(* ,t1 ,(calc-factor))))
 ((eq? t2 'div) (match 'div) (loop `(/ ,t1 ,(calc-factor))))
 (else t1)))))
(define (calc-factor)
 (let ((t1 (read-token)))
 (cond
 ((eq? t1 'lp) (let (( v (calc-exp))) (match 'rp) v))
 ((number? t1) t1)
 ((eq? t1 'sub) `(- ,(calc-factor)))
 (else (display "( or num ") (error "needed")))))
替换了最上面的代码中的对应部分后可以得到：
'(+ 1 (* (/ 44 2) (- 3)))

这是因为不是在解析时求值的，可以再略作修改实现if-then-else语句，因为if语句要根据条件语句选择执行的分支。
词法解析时把if识别为关键词所以不能作为变量名使用，语法解析时可以在解析过程中让else和最接近的if语句结合。
优先级方面新增的if-exp要低于已有的exp，也就是按习惯把这条规则书写在已有规则中calc-exp上方的位置。

依然可以用之前曾提到过的eval过程来得到这个list形式的sexp的计算结果。
在Scheme提供reader过程名为read以读入sexp，我们也可根据需要自行实现reader。
至于eval过程如何实现，将在后面的内容中提到。

* Scheme Toy #32.8 Interpreter
ee.zsy 2011年04月06日 21:55

在开始介绍Scheme中eval过程之前，先来演示一个简单BASIC风格的Interpreter。

这里使用默认的read过程读入一段脚本，并运算出结果，暂时假定eval过程还没有实现。
;basic.txt
(print "sum(1,100)")
(print "\n")
(let s 0)
(let i 1)
(label here)
(let s (+ s i))
(let i (+ i 1))
(if-goto (<= i 100) here)
(print s)

现在可以提供如下的一段解释器代码：
(display "Basic-Interpreter\n")
;DATA
(define *var-map* '())
(define (var-set! name value)
 (let ((p (assoc name *var-map*)))
 (if (pair? p)
 (set-car! (cdr p) value)
 (set! *var-map* (cons (list name value) *var-map*)))))
(define (var-get name)
 (let ((p (assoc name *var-map*)))
 (if (pair? p) (cadr p) #f)))
(define *basic-list* '())
(define *cdr-list* '())
(define (label-goto label)
 (set! *cdr-list* (member `(label ,label) *basic-list*)))
(define func-map
 `((+ ,+)(- ,-)(* ,*)(/ ,/)(<= ,<=)(< ,<)(= ,=)(>= ,>=)(> ,>)(<= ,<=)))
(define (func-get name)
 (let ((s (assoc name func-map)))
 (if s (cadr s) (display "Func no found"))))
;EVAL
(define (eval-exp x)
 (cond
 ((pair? x) (apply (func-get (car x)) (map eval-exp (cdr x))))
 ((symbol? x) (var-get x))
 (else x)))
(define (eval-stmt stmt)
 (let ()
 (cond
 ((string? stmt) (display stmt))
 ((eq? (car stmt) 'let) (var-set! (cadr stmt) (eval-exp (caddr stmt))))
 ((eq? (car stmt) 'label) #t)
 ((eq? (car stmt) 'if-goto) (if (eval-exp (cadr stmt)) (label-goto (caddr stmt))))
 ((eq? (car stmt) 'goto) (label-goto (cadr stmt)))
 ((eq? (car stmt) 'print) (display (eval-exp (cadr stmt))))
 (else (error "<Sorry for not understanding this statement.>")))))
;Interpret
(define (run!)
 (eval-stmt (car *cdr-list*))
 (if (null? (cdr *cdr-list*)) 0 (begin (set! *cdr-list* (cdr *cdr-list*)) (run!))))
(define (file->list file-name)
 (with-input-from-file file-name
 (lambda ()
 (let loop ((ls1 '()) (c (read)))
 (if (eof-object? c)
 (reverse ls1)
 (loop (cons c ls1) (read)))))))
(define (open-script! filename)
 (set! *basic-list* (file->list filename))
 (set! *cdr-list* *basic-list*))
;DEMO
(open-script! "basic.txt")
(run!)

运行时输出：
Basic-Interpreter
sum(1,100)
5050

在上面的代码是可行的，但还最好利用r6rs库中作出如下修改：
1.现在储存是使用关联列表外加getter和setter，修改后可改为Hashtable的实现，
2.现在解释器状态是放在全局变量中的，修改有可定义为一个Record，以实现(run (open-script "basic.txt"))。
这两个特性在r5rs中可以使用《srfi-69 Basic hash tables》和《srfi-9 Defining Record Types》。

为了节约篇幅，就说这些了。

* Scheme Toy #24.5 About
ee.zsy 2011年04月06日 23:04

来说明一下这个《Scheme Toy》系列是个怎么回事。

Scheme是一种编程语言，它是Lisp语言的主要方言之一。

Lisp语言取名自LISt Processing，由John McCarthy于1958发明，并于1960发表了题为《Recursive Functions of Symbolic Expressions and Their Computation by Machine, Part I》的论文，它展示了利用函数相关的运算符号可以建立一个图灵完备的算法语言。

John McCarthy因他在人工智能领域的贡献于1971年获得图灵奖，而Lisp语言本身便是为处理AI问题而生。Lisp语言是仅次于Fortran的第二古老的高级程序语言，不同于Fortran使用了基于指令和储存的冯·诺伊曼结构，它使用了Alonzo Church的Lambda演算这套函数相关的形式系统。这使得Lisp语言展现出强大的抽象能力。

Scheme语言由Guy L. Steele和Gerald Jay Sussman在1975-1980发表的一系列称为“Lambda Papers”的论文中提出。它是一种产生于Lisp和ALGOL的多范型的编程语言，并遵循了如下原则：设计计算机语言不应该进行功能的堆砌，而应该尽可能减少弱点和限制，使剩下的功能显得必要。

Scheme语言的主要影响源于《SICP》选择它作为授课语言，因为该语言形式简单，可以使课程不必牵制在语言的使用上。让对于所要解决的问题，算法和抽象这两者显得更为重要。

《Structure and Interpretation of Computer Programs》（计算机程序的构造和解释）是一本关于计算机程序设计的总体性观念的基础教科书，于1984年到2007年间作为MIT的6.001课程使用，即电子工程与计算机科学系的概览课程。

这里作了许多关于Scheme语言的描述，不过值得强调的是语言只是外表，而SICP中展现的设计方法才是这里要展现的重点。

至于标题中的另一个单词——Toy的意思是玩具，即玩弄起来有趣的东西。这里的这个Scheme Toy系列即以Scheme语言为载体来做一些有趣的使用。内容以《SICP》为主线，尽量跑题说一些相关但是不同的内容。因为《SICP》的一个本意就是提供一条线索，所以比较适合跑题用，不过个人能力极其有限无法跑远。

目前本系列进行到第二部分。第一部分侧重于介绍Scheme语言本身，包括语法和如何用来描述算法与结构，重在说明和条理的梳理。第二部分，也就是现在进行的部分，以代码和实例的展示为主，以展示特定问题的处理办法。整个的系列的动机是挑选和展现话题，而目前在内容的说明上有所欠缺，这可能需要在阅读特定话题时有相关背景知识的了解。

取名为Scheme Toy是出于一种娱乐的形态而产生的，意在描述处理问题的思维和乐趣。暂时没多少技术含量，说白了就是些计算机科学的入门级知识而已。而且因为篇目内容的选择偏向且局限于原理方面的，所以看起来不大实用。

目前每一篇的编写方式是选择话题后，写一些尝试用的代码和问题的分析，之后补充一些描述一起贴出来。暂时的完成度都只能算勉强，保证话题所要说的有所提及，但未必说明清楚。从当前的进展看，在文本的编排上还有很多提升的空间。

《SICP》的内容可以在以下地址获得：
http://mitpress.mit.edu/sicp/full-text/book/book.html

* Scheme Toy #33 Eval
ee.zsy 2011年04月14日 23:07

Scheme语言中提供了eval可以把列表形式的表达式作为参数进行求值，也就是说eval是对Scheme代码进行解析的过程。
这一篇的内容就是关于如何来实现一个eval过程，这个有个看起来似乎是循环定义的东西，所写的这个eval解析需要另一个eval过程来解析。
这个问题其实很好解决，我们只要用别的语言来写这个eval过程就可以了，哪怕只是很小的子集。
一旦一个语言能对自身很小的子集进行编译的话，就可以用从这个子集开始一步一步用语言自己为自己写一个更加完整的编译器。
对于Scheme而言，它的语言特性便是在静态词法作用域的无类型Lambda演算的基础上建立起来的。

如果仅仅要计算包含四则运算的s表达式的话，可以简单的实现为：
(define (eval-exp sexp)
 (define funs `((+ ,+)(- ,-)(* ,*)(/ ,/)))
 (cond
 ((pair? sexp)
 (let ((fp (assoc (car sexp) funs )))
 (if fp
 (apply (cadr fp) (map eval-exp (cdr sexp)))
 (error))))
 ((integer? sexp) sexp)
 (else (error))))
(eval-exp '(+ 1 (* 2 3))) ;=> 7
之后可以在这基础上添加变量的处理，以及像if这样不会立即对参数求值的SpecialForm，这些前一篇里已经写到了。

也可以修改让解析的过程和求值的过程分为两步来进行，将表达式转化为闭包使得多次求值不需重复解析。
(define (analyze-exp sexp)
 (define funs `((+ ,+)(- ,-)(* ,*)(/ ,/)))
 (cond
 ((pair? sexp)
 (let ((fp(assoc (car sexp) funs )))
 (if fp
 (let ((f (cadr fp)) (as (map analyze-exp (cdr sexp))))
 (lambda () (apply f (map (lambda (i) (i)) as))))
 (error))))
 ((integer? sexp) (lambda () sexp))
 (else (error))))
(let ((proc1
 (analyze-exp '(+ 1 (* 2 3)))))
 (proc1))

接下来实现一个scheme里最重要的form，它便是lambda，这里要实现的包括函数调用和静态词法作用域。
其他的form和内部过程都可以用用lambda来表示，虽然通常出于效率考虑并不这样实现，例如对点对的操作就可以这样写：
;type pair = Nil | Cons 'a*'b;;
(define (cons x y)
 (lambda (m) (m x y)))
(define (car z)
 (z (lambda (p q) p)))
(define (cdr z)
 (z (lambda (p q) q)))
(car (cdr (cons 1 (cons 2 '())))) ;=>2
下面就一步一步来实现这个lambda的解析和运算操作。

首先来定义表示Environment的类型：
;type env=Env of (key*value) list*env|Root;;
(define (make-env alist env)
 (cons alist env))
(define (lookup key env)
 (let ((p (assoc key (car env))))
 (if p
 (cdr p)
 (if (null? (cdr env))
 #f
 (lookup key (cdr env))))))
(lookup 'c (make-env '((a . 1)(b . 2)) (make-env '((c . 3)) '())))
;=> 3

接下来要实现的是允许表达式中出现变量以及是lambda语句所对应的运算，在每次lambda使用的时候，创建一个新的env以绑定变量。
(define pri-env (make-env `((+ . ,+)(- . ,-)(* . ,*)(/ . ,/)) '()))
(define (eval-exp sexp env)
 (cond
 ((and (pair? sexp) (eq? (car sexp) 'lambda))
 (lambda args (eval-exp (caddr sexp) (make-env (map cons (cadr sexp) args) env))))
 ;;这里仅仅执行了lambda中的一条语句，只在无副作用的情况下不影响结果。
 ((pair? sexp)
 (let ((op (eval-exp (car sexp) env)))
 (cond
 ((or (and (symbol? op) (lookup op env)) (and (procedure? op) op))
 => (lambda (f) (apply f (map (lambda (i)(eval-exp i env)) (cdr sexp)))))
 (else (error)))))
 ((integer? sexp) sexp)
 ((symbol? sexp) (lookup sexp env))
 (else (error))))
(eval-exp '((lambda (x y) (x y 2)) (lambda (x y) (+ x y)) x) (make-env '((x . 3)) pri-env))
;=> 5
其中要注意到是lambda表达式在执行时使用的是它定义时的env而非调用者的env。
此外以上代码中出现的lambda是起来类型的作用，可以用list或recode当作一种类型处理。
这不是想用lambda递归的实现lambda，如果用Ocaml的类型系统来写的话可能会更加清晰一些吧。
这里也可以再把解析和求值过程分开来，这个得到的中间过程需要增加一个表示env的参数.
即用(lambda (env) ... )代替先前例子中的(lambda () ... )，其他部分不受影响。

有了lambda之后，逻辑运算可以这样定义：
;type bool = True | False;;
(define (true p q) p)
(define (false p q) q)
(define (if p x y) (p x y))
(if true 1 0) ;=>1
还包括最基本的自然数及运算，用lambda演算的习惯写法的话：
;type num = Zero | Succ of num;;
0 = λf.λx.x
SUCC = λn.λf.λx.f(n f x)
略
...

现在回想一下之前写过的例子，看看还缺少什么也很基本东西，比如递归求和之前是这样写的：
(define (sum x)
 (if (zero? x)
 0
 (+ x (sum (- x 1)))))
(sum 100) ;=>5050
看看现在的情况，数的运算已经定义了，逻辑运算也已经定义了，还缺个define没有。
如果define是像let那样进行简单的绑定操作的话，和用lambda进行绑定参数没有差别：
如(define x 1) (+ x 2) ;=> 3 ，就等价于 ((lambda (x) (+ x 2)) 1) ;=> 3 。
不过现在的问题是这里的sum过程是递归定义，而变量不能在还没有绑定的时候使用。
也就是说我们不能用上面这种较直接的方式来改写递归的绑定操作，不过间接的还是可以的。

对于变量f或函数f(n)，存在函数g满足f=g(f)或f(n)=g(f(n))时，则f叫做g的不动点。例如0和1是f(x)=x^2的不动点。
如果对于任意函数f都存在函数fix使得f(fix(f)) = fix(f)成立，则不动点fix称为不动点算子（Fixed Point Combinator）。
现在消除掉递归的定义，为上面的sum函数定义一个factory函数，写做：
(define (factory sum)
 (lambda (x)
 (if (zero? x)
 0
 (+ x (sum (- x 1))))))
这个factory函数接受sum函数作为参数并返回sum函数。
现在书写下来的定义上是没有递归了，问题怎么在获得sum前用素描当参数来调用这个factory函数。
当然解决办法肯定是有的，不然就不会把文字写到这里，做这么些铺垫了。这里用到办法，正是不动点。
现在factory(sum(x))==sum(x)，函数sum是函数factory的不动点，现在的目标是用factory来表示这个不动点sum。
我们利用满足fix(factory)是factory的不动点的不动点算子fix，当factory的不动点存在且唯一时，可以得到sum==fix(factory)。
于是可以用这样的方式来定义先前的sum函数为(define sum (fix factory))，要求是这样的一个不动点算子fix存在。
在无类型lambda演算中最著名的不动点算子是由Haskell B. Curry 发现的 Y组合子。
它写为 Y = λf.(λx.f (x x)) (λx.f (x x)) ，能对于任意函数g使得 Y g==g (Y g)。
也就是利用Y组合子能够利用一个非递归的函数映射到我们所需要的递归函数上来。

现在换一种方式来把这个问题说的简单一些，上面的。
首先回到原本的定义上，它是：
(define (sum x)
 (if (zero? x)
 0
 (+ x (sum (- x 1)))))
显示的把lambda写出来就是：
(define sum
 (lambda (x)
 (if (zero? x)
 0
 (+ x (sum (- x 1))))))
下面把sum改写为函数并添加一个意义不大的参数：
(define (sum0 s)
 (lambda (x)
 (if (zero? x)
 0
 (+ x ((sum0 s) (- x 1))))))
然后利用柯里化（Currying），接受多个参数的函数和接受一个参数并返回接受剩余参数函数的函数的等价关系。得到：
(define sum0
 (lambda (s)
 (lambda (x)
 (if (zero? x)
 0
 (+ x ((sum0 s) (- x 1)))))))
它也等价于：
(define sum0
 (lambda (s x)
 (if (zero? x)
 0
 (+ x (sum0 s (- x 1))))))
现在的参数s不起任何作用，不过我们定义：
(define (sum n)
 (sum0 sum0 n))
在这个对sum0的调用中，s等于sum0，于是可以把sum0代入得到：
(define (sum n)
 (let ((sum0
 (lambda (s x)
 (if (zero? x)
 0
 (+ x (sum0 s (- x 1)))))))
 (sum0 sum0 n)))
不过要注意的是let是lambda的语法糖，并且不允许递归定义。
于是利用这个例子中s和sum0等价，写为合法的表达式就是：
(define (sum n)
 (let ((sum0
 (lambda (s x)
 (if (zero? x)
 0
 (+ x (s s (- x 1)))))))
 (sum0 sum0 n)))
消灭一些语法糖后，包括define和let，我们得到：
(define sum
 (lambda (n)
 ((lambda (sum0)
 (sum0 sum0 n))
 (lambda (s x)
 (if (zero? x)
 0
 (+ x (s s (- x 1))))))))
调用(sum 100) ;=> 5050 ，现在目的达到了。

现在来看看这个改写过程中有什么可以复用的东西。
比如说找到一个不动点算子，这样就可以通过编写一个非递归的起工厂作用的函数来创建递归函数了。
在上面的例子中拆一个函数定义出来就是可以得到：
(define (c f)
 (lambda (n)
 ((lambda (func)
 (func func n))
 f)))
(define factory
 (lambda (s x)
 (if (zero? x)
 0
 (+ x (s s (- x 1))))))
(define sum (c factory))
而我们先前写过那个有不动点的函数是：
(define factory
 (lambda (sum)
 (lambda (x)
 (if (zero? x)
 0
 (+ x (sum (- x 1)))))))
比较这两个factory函数，我们需要的是一个对应下面这个factory的c函数，它便是所说的Y组合子。
因为Y组合是call-by-name的，这里得到的是另一作用一样但call-by-value的Z组合子：
(define (Z f)
 ((lambda (g)
 (g g))
 (lambda (h)
 (f (lambda x
 (apply (h h) x))))))
于是可以(define sum (Z factory))并计算(sun 100)得到5050。
至此大功告成了，单个递归定义的函数已经可以有通用的方式通过所对应的非递归形式来转化了。
而在带类型的lambda演算的语言OCaml中可以类似的写出：
type 'a recc = Pack of ('a recc -> 'a)
let unpack (Pack x) = x
let y f =
let g = Pack(fun h x -> f (unpack(h) h) x)
in f (unpack(g) g)
;;
let f =
function sum ->
 function
 0 -> 0
 | x -> x + sum(x - 1)
;;
print_int ((y f) 100);;
输出为：5050- : unit = ()。
其中所定义的类型是为了辅助编译器对递归类型的识别和处理。

不过现在还剩下一个问题，就是两个函数互相递归定义该如何来转化呢，至少不能直接使用这个Y组合子。
比如：
(define (even? n)
 (if (= n 0)
 true
 (odd? (- n 1))))
(define (odd? n)
 (if (= n 0)
 false
 (even? (- n 1))))
方法还是使用类似的方式进行处理，得到：
(define even?-and-odd?
 ((lambda (even? odd?)
 (list
 (lambda (x) (even? even? odd? x))
 (lambda (x)(odd? odd? even? x))))
 (lambda (ev? od? n)
 (if (= n 0) #t (od? ev? od? (- n 1))))
 (lambda (ev? od? n)
 (if (= n 0) #f (ev? ev? od? (- n 1))))))
(define even? (car even?-and-odd?))
(define odd? (cdr even?-and-odd?))
注意，这里的define仅是起绑定的作用，可以用let或lambda来改写。
在scheme语言中define和letrec语句会出现递归定义，都可以采用这样的方式来消除递归。

最后我们再继续对这个lambda表达式做一些改进，来为eval增加一个表示延续（Continuation）的参数。
此时在自己定义的Lambda表达式被求值的时候，不是直接返回结果，而是以自身的值作为参数去调用cont。
这样的做的一个好处是让eval变成了尾递归的实现，而且当然好处会不止仅仅这一点。
为了简单起见，这里以最初的那个计算四则运算的eval为基础来修改：
(define (analyze-exp sexp)
 (define funs `((+ ,+)(- ,-)(* ,*)(/ ,/)))
 (define (map-args aps cont)
 (if (null? aps)
 (cont '())
 ((car aps)
 (lambda (arg)
 (map-args (cdr aps) (lambda (args) (cont (cons arg args))))))))
 (cond
 ((pair? sexp)
 (let ((fp (assoc (car sexp) funs)))
 (if fp
 (let ((f (cadr fp)) (args (map analyze-exp (cdr sexp))))
 (lambda (cont) (map-args args (lambda (x) (cont (apply f x))))))
 (error))))
 ((integer? sexp) (lambda (c) (c sexp)))
 (else (error))))
(let ((proc1
 (analyze-exp '(+ 1 (* 2 3)))))
 (proc1 display))
;=> 7
不过在这里例子中似乎好处什么的还看不出来，那就后面在具体的说吧。

函数的调用可以看作一个Stack结构满足FIFO的顺序，在上面的例子中用了Scheme本身的函数调用Stack。
不过还用到了一个env变量，它包含了此次函数调用的局部变量以及它上层的env变量，这个上层变量和调用Stack上的顺序不一定一致。
也就是说access link和control在允许函数嵌套定义的时候，有一致的情况也有不一致的情况。
比如考虑(((lambda (x y) (lambda (x) (+ x y))) 1 2) 3)的函数调用顺序和变量的作用域情况。
至于如何利用Continuation-passing style来简化常见的基于Stack的实现，这个以后再写吧。

考虑篇幅，之后再来详细写吧，关于Eval确实还能牵扯到若干东西。

* Scheme Toy #33.5 Product
ee.zsy 2011年04月20日 13:08

这篇找一个之前已经提到过——笛卡儿积。它是一种集合运算，可以在算法中作为一个抽象的基础而隐藏了实现的细节。
例如对于两个列表'(1 2) '(3 4 5)，它的笛卡尔积有6个元素，分别是'((1 3) (1 4) (1 5) (2 3) (2 4) (2 5))。
这个问题没什么特别的地方，先警告一下接下来的内容有凑字数的嫌疑。

这个过程可以简单的这么来写：
(define (product x y) (apply append (map (lambda (a) (map (lambda (b) (list a b)) y)) x)))
然后使用的时候将这两个列表作为操作数，而用刚才所定义的操作符:
(product '(1 2) '(3 4 5))
两个map嵌套使用算Scheme中一种比较固定的用法了，比如我可以抽象出(product-map proc x y)。
如果要过滤元素的话可以filter传给product的参数或传出的结果，有时需要把map和filter合并为一趟。
之前曾写到过map是可以用cons/car/cdr来自定定义的，所以如果觉得map代码把其中的迭代过程显示的不明显的话，可以手工Inline。
如果要Lazy的话，也就是只求值需要个数的前若干元素，可以将cons配合delay使用，或者为map定义一个lazy版本，这里不展开了。

现在也可定义一个名为fold-right（R6RS和OCaml里同叫这个名称，它们提倡不用缩写）的过程来抽象map和filter中的迭代过程：
(define (fold-right proc init list1)
 (if (null? list1)
 init
 (proc (car list1) (fold-right proc init (cdr list1)))))
(define (map proc list1)
 (fold-right (lambda (a b) (cons (proc a) b)) '() list1))
(define (filter proc list1)
 (fold-right (lambda (a b) (if (proc a) (cons a b) b)) '() list1))
如果对fold-right做Inline的话，得到就是前面写过的map和filter的递归定义。

下面要做的就是继续修改上面的代码，那么首先来让product可以接受任意多（0,1,2,3...）的参数，可以这样写：
(define (product . lists)
 (define (product-map proc x y)
 (apply append (map (lambda (a) (map (lambda (b) (proc a b)) y)) x)))
 (if (null? lists) '()
 (let loop ((a (car lists)) (b (cdr lists)))
 (if (null? b)
 a
 (loop
 (product-map
 (lambda (x y) (append (if (pair? x) x (list x)) (list y)))
 a (car b))
 (cdr b))))))
(product '(1 2) '(3 4 5) '(6) '(7))
;=>((1 3 6 7) (1 4 6 7) (1 5 6 7) (2 3 6 7) (2 4 6 7) (2 5 6 7))
如果仅考虑参数个数2,3...也可退化地写成：
(define (product . lists)
 (let loop ((a (map list (car lists))) (b (cdr lists)))
 (if (null? b)
 a
 (loop
 (product-map
 (lambda (x y) (append x (list y)))
 a (car b))
 (cdr b)))))
或者递归：
(define (product . lists)
 (let ((a (car lists)) (b (cdr lists)))
 (if (null? b)
 (map list a)
 (product-map cons a (apply product b)))))
而且这样还避免每次append都要copy的消耗了，只能加了递归的Stack操作（性能等价于cons）。
上面这种递归是fold-right的顺序先计算到列表的最右侧，因为用了map list换一种结合顺序对init变量操作：
(define (product . lists)
 (fold-left (lambda (a b) (product-map cons a b) ) (map list (car lists)) (cdr lists)))
(product '(1 2) '(3 4 5) '(6))
;=>((6 3 1) (6 3 2) (6 4 1) (6 4 2) (6 5 1) (6 5 2))
其中由于fold-left不像fold-right先把proc作用到(car list1)和余下的元素上，所以cons是结合fold-right使用的。
之后可以用map reverse来逆置顺序，以达到和之前结果是一样的，不过这个fold-left改写的不划算，delay也不方便了。
对于参数个数0，1的情况额外只需要增加判断：
(define (product . lists)
 (cond ((null? lists) '())
 ((null? (cdr lists)) (car lists))
 (else
 (let loop ((lists lists))
 (let ((a (car lists)) (b (cdr lists)))
 (if (null? b)
 (map list a)
 (product-map cons a (loop b))))))))
这便是我们得到的最终的结果，之前写出的其他代码都可以看作半成品的废墟了。

说了这么些，下面还是回到最基本最简单的一种写法上来吧——
用一个数组来保存迭代的状态，即现在尝试到参数的每个列表的第几个元素。
比如(product1 '(1 2) '(3 4 5) '(6) '(7))结果中的'(1 5 6 7)对应的向量就是#'(0 2 0 0)。
于是可以定义过程next来得到下一个迭代向量，比如这里就是#'(1 0 0 0)，考虑进位和溢出两种情况。
这一过程算是笛卡儿积最简单的求法了，比上面列的要简单，并且这也是表示了算法中的回溯过程。
在当前位要溢出的时候，清零并去上一位上增加一，直到第一溢出为止。

那么现在，还是回到把问题继续复杂化的道路上，尝试一些更通用的模型来进行计算。
比如下面来求笛卡尔积的过程（状态的转化）看作图，然后进行深度优先搜索。
把所要求积的每一个列表看作搜索树的一层，所要作的就是输出全部到叶节点的路径。
代码可以是：
(define (product . lists)
 (map reverse
 (let rec ((deep lists) (path '()))
 (if (null? deep)
 (list path)
 (apply append
 (map
 (lambda (i) (rec (cdr deep) (cons i path)))
 (car deep)))))))
这里对于参数为0和1的情况有输出时候，不过和之前定义的输出不一致。
如果认为有必要一致的话，可以对这两种条件做单独的处理以符合符合之前的输出。
比如现在：
(product '(1 2) '(3 4 5)) ;=> '((1 3) (1 4) (1 5) (2 3) (2 4) (2 5))
(product '(1 2)) ;=> ((1) (2))
(product) ;=> '(())
而对下面两种情况原先定义的输出是(1 2)和()，原先的定义符合笛卡尔积的定义。
现在的结果事实上是返回的搜索路径，可以像先前一样用一个cond语句对这种情况单独处理：
最终代码略（注意，上面一直是在给潘成品哦），或者针对其他的场合进行修改。

那么现在，继续修改，再更换一种方式来描述对这个问题的计算过程。
首先，回到之前写过一个名叫for-each的过程上：
(define (for-each proc list1)
 (if (null? list1)
 '()
 (begin
 (proc (car list1))
 (for-each proc (cdr list1)))))
(for-each display '( 1 2 3 4 5)) ;=> 12345
下面给其中的参数过程proc添加传递一个表示延续的参数：
(define (for-each-with-continuation proc list1)
 (if (null? list1)
 '()
 (begin
 (call-with-current-continuation (lambda (c) (proc c (car list1))))
 (for-each-with-continuation proc (cdr list1)))))
(for-each-with-continuation (lambda (c i) (display i) (c)) '(1 2 3 4 5))
通过这个传递出来的延续，我们可以记录下搜索过程中的每一个状态。
一个默认的执行顺序，一个是保存了迭代中的状态，事实上我们现在有两个延续可以使用。
可以称它们分别叫success和fail，代表搜索过程中访问兄弟节点和回溯到上一节点：
(define (for-each-with-continuation2 success proc list1)
 (if (null? list1)
 (success)
 (begin
 (call-with-current-continuation (lambda (fail) (proc fail (car list1))))
 (lambda () (for-each-with-continuation2 success proc (cdr list1)))
 )))
(define (for-continuation cont)
 (let ((value (cont)))
 (if (null? value) '()
 (begin
 (for-continuation cont)))))
(for-each-with-continuation2
(lambda () '())
(lambda (backtrack i) (display i) (backtrack))
'(1 2 3 4 5))
这个修改仅仅是让success和fail这连个延续好起来可能明显一些，目的在于下面：
(define (for-each-with-continuation3 cont proc list1)
 (if (null? list1)
 '()
 (proc
 (lambda () (for-each-with-continuation3 cont proc (cdr list1)))
 (car list1))))
这里把call-with-current-continuation语句给去掉了（不仅看不见，也没有调用它，也没有把状态存在在变量中），只用到了尾递归（事实上同时也是GOTO语句）来表达。
现在再来看Scheme语言中的continuation机制，只不过是在lambda演算基础上引入GOTO而已，它可以作为一种编程方式的抽象而不必看作在实现上的什么特殊的特性。
（注意，这段代码有问题的，for-continuation没起作用。现在内容以修正，变换的目的是对的但方式有问题。后面会详细说到。）

对于求笛卡尔积而言，延续作用是可以用来表述深度搜索过程中的状态。
下面所要实现的内容很明确了这样写出：
1.如果当前是叶节点则输出，
2.如果当前是没有兄弟则输出并回溯，
3.搜索兄弟节点，并进入该节点的第一个子节点。
这里用success指向搜索兄弟节点的过程，用fail指向回溯的过程。
得到的代码是：
(define (in-node bt deep path)
 (if (null? deep)
 (begin
 (display (reverse path))
 (bt))
 (let loop ((ways (car deep)))
 (if (null? ways)
 (bt)
 (begin
 (call-with-current-continuation
 (lambda (here)
 (in-node
 here
 (cdr deep)
 (cons (car ways) path))))
 (loop (cdr ways)))))))
(define (product . lists)
 (in-node (lambda () '()) lists '()))
(product '(1 2 3) '(4 5) '(6))
;=> (1 4 6)(1 5 6)(2 4 6)(2 5 6)(3 4 6)(3 5 6)
把其中的display移到主过程的外面来可以写成：
(define (in-node push bt deep path)
 (if (null? deep)
 (push bt (reverse path))
 (let loop ((push push) (ways (car deep)))
 (if (null? ways)
 (bt push)
 (loop
 (call-with-current-continuation
 (lambda (here)
 (in-node
 push
 here
 (cdr deep)
 (cons (car ways) path))))
 (cdr ways))))))
(define (in-push bt x)
 (display x)
 (bt in-push))
(define (product . lists)
 (in-node in-push (lambda (push) '()) lists '()))
如果不想要这个display的话，可以用Producer-Consumer的形式：
(define (make-generator factory)
 (define produce '())
 (define continue '())
 (define (yield value)
 (call-with-current-continuation
 (lambda (here)
 (set! continue here) (produce value))))
 (set! continue (lambda () (factory yield)))
 (lambda ()
 (call-with-current-continuation
 (lambda (here)
 (set! produce here) (continue)))))
这段无关的代码的用法是：
(define (range low high)
 (lambda (yield)
 (let loop ((i low))
 (if (<= i high)
 (begin
 (yield i)
 (loop (+ i 1)))
 '()))))
(define g (make-generator (range 1 3)))
(g) ;=>1
(g) ;=>2
(g) ;=>3
(g) ;=>'()
(g) ;=>'()
而上例子中的display可以用yield来替代，然后定义如下的Consumer：
(define (generator->list gen)
 (define result '())
 (let loop ()
 (let ((value (gen)))
 (if (null? value)
 (reverse result)
 (begin
 (set! result (cons value result))
 (loop))))))
这样结果就被转化为了list的形式，现在这个Continuation版本就可以有之前一样的输出了。
想消除上面出现的set!的话，这里就不再尝试，不过貌似有可行的方案。比如说
为produce增加一个表示continue的参数，然后为continue增加一个表示produce的参数。
不过最终的输出结果一定要有副作用的方式，因为最后的backtrack是一直会退回到执行前的状态的。

以上过程可以进一步抽象成为amb运算符，这个例子在Scheme相关的Essay中算比较常见的话题了。
在amb的执行过程中存在两个延续，分别是sucess和fail，前者用于继续执行，后者用户回溯。
达到深度，或者是一定义的条件都可以作为回溯的触发点，求笛卡尔积的过程可以扩展为语言中的列表生成特性（amb+require+collect）。
前面说过延续可以让scheme来处理，也可以通过增加参数手动的处理，这里采用不大美观的手动方式。
加入首先这样写出：
(define (amb x)
 (if (null? x)
 '()
 (begin
 (display (car x))
 (amb (cdr)))))
添加参数后得到：
(define (amb back x)
 (if (null? x)
 (back)
 (begin
 (display (car x))
 (call-with-current-continuation
 (lambda (here)
 (amb here (cdr x)))))))
然后再把display按照之前的方法给提取出来：
(define (amb cont back x)
 (if
 (null? x)
 (back)
 (begin
 (call-with-current-continuation
 (lambda (here)
 (cont here back (car x)))
 (call-with-current-continuation
 (lambda (here)
 (amb cont here (cdr x))))))))
因为和之前那个笛卡尔积的例子类似，这里就不再详细写下去了，虽然这里也没说清楚什么。
不过显然在使用的时候是不希望每次amb都显示的调用这两个参数的，可以引入全局变量或者利用Monad中的bind操作。
关于延续的CPS变换，之后可能会详细的介绍到，不过将不作为主线内容。
暂且只是以来逻辑、资料、测试说说，算勉强可靠吧。当前知识有限，有些东西还无法说明清楚。
前一篇里把Scheme代码转化到了CPS风格的Lambda，是要提供对Lambda的解析，就可以让完整的Scheme代码执行了。

最后简单的说的话就像这样一个例子：
(define (add . args)
 (apply + args))
(display (add 1 2 3))
本来是要使用它的返回值的，
(define (add/c cont . args)
 (cont (apply + args)))
(add/c display 1 2 3)
现在必须写为尾递归的形式。
也就把
(define (add . args)
 (call/cc
 (lambda (break)
 (display "here")
 (break)
 (error "not triggered")))
 (apply + args))
(display (add 1 2 3))
改写为
(define (add/c cont . args)
 ((lambda (break)
 (display "here")
 (goto break)
 (error "not triggered"))
 (lambda () (goto cont (apply + args)))))
(goto add/c display 1 2 3)
其中所用的goto需要额外的实现上的支持，不过仍可在Scheme的范围内。
比如“((call/cc (lambda (return) ... )))”：
(define (myfun)
 (call-with-values
 (lambda ()
 (call/cc
 (lambda (return-apply)
 ...
 (return-apply func2 . args)
 ...
 )))
 (lambda (fun . args)
 (apply fun args))))
可以直接实现为命令式的goto语句，或者支持尾递归的return语句，这里使用的后者。
一般的情况是函数接受一个参数表示它的延续，并用一个参数（返回值）去调用这个延续。
当然也有传入多个延续，和返回多个返回值的情况，在CPS变换中它们和Lambda演算仍然是一致的。
在需要把延续保存在变量中的时候，或者需要多个返回值的时候，都可以使用延续和CPS这两种相统一的方式。

嘛，这篇是“意识流”？

* Scheme Toy #33.7 Data
ee.zsy 2011年04月20日 13:11

SXML是S-expressions形式的XML（Extensible Markup Language，可扩展置标语言），好处是可以用单一的语言来实现的XML的各种扩展机制和工具。
而用Scheme实现的DSSSL（Document Style Semantics and Specification Language），拥有比XML更长久的历史。
以下内容是关于标记语言的书写的转换，将不涉及到具体的语言标准。

例如现在定义一种标记语言，其格式依照S-expression书写，并有如下的类型要求。
操作符car的位置是tag，操作数cdr是children，如果第一个操作数是@开头的list则用来表示attributes。
其中类型tag为symbol，children是symbol或number或string或S-expression或为空，attributes是(symbol string)构成的关联列表。

不考虑类型错误的检测的话，可以写出这样的转换代码：
(define (to-xml sexp)
 (define (to-attrs alist)
 (if (null? alist)
 ""
 (let ((attr (car alist)))
 (string-append
 " " (symbol->string (car attr))
 "=\"" (cadr attr) "\"" (to-attrs (cdr alist))))))
 (cond
 ((pair? sexp)
 (let* ((tag (symbol->string (car sexp)))
 (has-attrs?
 (and (pair? (cdr sexp)) (pair? (cadr sexp)) (eq? (caadr sexp) '@)))
 (attrs (if has-attrs? (to-attrs (cdadr sexp)) ""))
 (children (cdr (if has-attrs? (cdr sexp) sexp)))
 (has-child? (not (null? children))))
 (apply
 string-append
 (append
 (list "<" tag attrs (if has-child? "" "/") ">")
 (map to-xml children)
 (if has-child?
 (list "</" tag ">")
 (list))))))
 ((string? sexp) sexp)
 ((number? sexp) (number->string sexp))
 ((symbol?) (symbol->string sexp))
 (else "error")))
(display (to-xml '(p "go " (a (@ (href "/")) "home") (br))))
得到的输出是：
go <a href="/">home</a> 
这里同时进行了解析和生成两个步骤，将一种S-exp的形式的形式表现的额数据转化为了XML格式。
如果想依据条件生成不同的文本，可以用加入条件语句，可以用quasiquote来生成list。

另一方面，我们可以为不同的标签定义单独的解析规则。
例如html中的strong标记：
(define (strong . texts) (to-xml (cons 'strong texts)))
(strong "hello") ;=> hello
和上面的不同在于，这里的strong是定义为一个过程的。
写下来的SXML可以eval的代码，而不是供解析list数据。
这里再次强调一下，这里的SXML已经变成了实际的代码了。
上面的一段用到的例子可以变为执行这样的一段表达式：
(p "go " (a (@ '(href "/")) "home") (br))
并在其中用到了p、a、@、br这四个过程，执行后返回一样的结果。
如果想依据条件生成不同的文本，可以直接使用Scheme的if语句。

如果觉得交给scheme执行不安全的话，可以自行定义eval：
(define (eval-sxml sexp)
 (define tags
 `((strong
 ,(lambda texts (apply string-append (append '("") texts '("")))))))
 (cond
 ((pair? sexp)
 (apply
 (cadr (assoc (car sexp) tags))
 (map eval-sxml (cdr sexp))) )
 ((string? sexp) sexp)
 (else "error")))
(eval-sxml '(strong "hello"))
;=> "hello"
这里定义的不完整，可以继续扩充，定义更多的tag或者实现更多的语句。
现在可以看到，SXML不仅仅是一种数据格式，而是实实在在的一种标记语言。
在上面这个实例中可以说一组tags被看作看作了scheme的一个库，比如全部html标记就是一个库。
并这里的eval虽然和最上面直接解析是同样的作用，但是增加了tag的灵活性。
Lisp中的define-marco就是把参数当作了list使用，属于一个read后eval前的eval过程。

由于变换的规则是可以定义的，我们就可以定义一组tags，然后定义不同的规则以转化到XML、TeX、Text和更多的格式。
以上写法在有类型的OCaml中也是可行的，例如下面两行都是合法的表达式：
type txsml=Tag of string|Str of string|Exp of Tag*txml list;;Exp("strong",[Str "hello world"])
let strong text=""~text~"";;strong "hello world";;
前者定义了类型并用以此定义了数据，而后者则定义了可供执行的过程并写出了代码。

* Scheme Toy #34 RPN
ee.zsy 2011年04月24日 22:39

这次内容将简单地按照代码加说明的形式展开，话题继续是关于Eval的模型，这次会说Lambda演算之外的。

例如Stack是一种FIFO的数据结构，它就可以用来实现逆波兰（Reverse Polish notation）表达式（Postfix后缀表达式）的计算。
那么在说明开始前，先来定义一个Stack结构，这次使用Message passing的风格来写：
(define (make-stack)
 (define stack '())
 (define (empty?)
 (null? stack))
 (define (push item)
 (set! stack (cons item stack)))
 (define (pop)
 (if (empty?)
 '*empty*
 (let ((item (car stack)))
 (set! stack (cdr stack))
 item)))
 (define (dispatch m)
 (case m
 ((push) push)
 ((pop) pop)
 ((empty?) empty?)))
 dispatch)
(define (push! stack item)
 ((stack 'push) item))
(define (pop! stack)
 ((stack 'pop)))
对应的简单的示例兼测试是：
(define s (make-stack))
(push! s "1")
(push! s 2)
(pop! s) ;=>2
(pop! s) ;=>"1"
(pop! s) ;*empty*
而下面将要eval表达式可以是这个样子的：
'(1 2 + 3 4 5 - * /)
其计算规则是数字直接push，运算符pop其操作数并push回结果：
;;eval-stack:list->'a
(define (eval-stack exp)
 (let ((stack (make-stack)))
 (define (make-bin-op op)
 (lambda()
 (let* ((a (pop! stack)) (b (pop! stack)))
 (push! stack (op b a)))))
 (define ops
 (list
 (list '+ (make-bin-op +))
 (list '- (make-bin-op -))
 (list '* (make-bin-op *))
 (list '/ (make-bin-op /))))
 (do ((i exp (cdr i))) ((null? i) (pop! stack))
 (let ((item (car i)))
 (cond
 ((number? item)(push! stack item))
 ((assoc item ops) => (lambda (x) ((cadr x))))
 (else (error)))))))
执行的结果是：
(eval-stack '(1 2 + 3 4 5 - * /))
;=> -1
手工分解步骤进行计算也是得到同样的结果。

于是现在除了之前提到过的在字符串和s表达式之间的转换（解析和打印双向的操作），
现在也可以把上面的后缀表达式与日常书写的中缀以及Scm中使用的前缀表达式之间转换了。
例如下面选择其中最简单的（呵呵）前缀转中缀的四则运算的情况来进行演示：
;;pre->postfix:nested list->flat list
(define (pre->postfix sexp)
 (define (pass1 sexp)
 (cond
 ((pair? sexp)
 (let ((len (length sexp))
 (op (car sexp)))
 (define (len-op? num sym)
 (and (= len num) (eq? sym op)))
 (define (long-exp)
 `(,@(pass1 (cadr sexp))
 ,@(pass1 (caddr sexp))
 ,op
 ,@(apply append (map (lambda (i) `(,@(pass1 i) ,op)) (cdddr sexp)))))
 (cond
 ((len-op? 1 '+) '(0))
 ((len-op? 1 '*) '(*))
 ((or (len-op? 2 '+) (len-op? 2 '-)) `(0 ,@(pass1 (cadr sexp)) ,op))
 ((or (len-op? 2 '*) (len-op? 2 '/)) `(1 ,@(pass1 (cadr sexp)) ,op))
 ((and (>= len 3) (memq op '(+ - * /))) (long-exp))
 (else (error)))))
 ((number? sexp) `(,sexp))
 (else (error))))
 (pass1 sexp))
此时执行如下的表达式：
(pre->postfix '(+))
(pre->postfix '(- 1))
(pre->postfix '(* 1 2))
(pre->postfix '(/ 1 2 3))
(pre->postfix '(+ (- 1) (* 2 3) (/ 4 5 6)))
将得到：
(0)
(0 1 -)
(1 2 *)
(1 2 / 3 /)
(0 1 - 2 3 * + 4 5 / 6 / +)
其结果可以用如下的过程测试：
(define (test1 sexp)
 (= (eval sexp) (eval-stack (pre->postfix sexp))))
例如下面这行表达式的结果为#t
(test1 '(+ (- 1) (* 2 3) (/ 4 5 6)))。
通常可以把一组测试写在一起，依次执行每条测试，或者后初始化和销毁用的过程。
执行自动测试时，让不通过的测试抛出异常并记录，并继续测试，最后得到统计报告。

在Scm中变量名所指向的cell是根据词法作用域的，一个函数中可以使用的变量包括它的参数，以及它定义位置所引用的外部的变量（存在inner环境到outer环境中成员的引用）。
在函数（过程）被调用时接受它的返回值的表达式称为它的延续，抛出异常是使用了handler代替了当前默认的延续，延续是一个lambda表达式（的值）。
那么现在，来继续增强上面所写的后缀表达式求值过程吧，加入函数调用，变量引用，以及分支判断，让它功能能够再丰富一些。

具体的说，可以把这个基于Stack的指令序列按照下列方式，尽可能简单直观地来一步步扩充。
那么首先是，语句块操作block end，例如'(block 1 1 + end)，语句块的中的执行没有执行而是作为一种类型压在了Stack当中。
实现上用in-block-flag标记是否在块语句内，并在dispatch时给这两个关键词给最高的优先级，block标记开始end保存语句序列。
有了语句块接下来就是条件语句了'(bool proc1 proc2 ifelse)，因为条件语句后的分支指令要在条件满足和才能执行，语句块可以起这样的作用。
可以写出语句'(1 2 > block 1 end block 1 1 + end ifelse)的执行结果是2，实现上ifelse作为普通的操作符即可，不需要特殊处理。
此时有用来执行语句块的do操作（'(block 1 end do)），虽然不一定要提供给用户这个操作符，在其他指令的内部实现中是用得到的。
变量的绑定使用define，例如'(name value define)表示把符号value对应的值并绑定到符号name上，其中value可以是常量或者quote的符号并且其他地方出现也要求值。
这里的实现和实现一个lisp的eval一样，需要定义一个env（环境）类型来存放映射关系。有一个全局环境，语句块也可以有指向外部语句块的嵌套环境。
由于这里所要实现的静态词法作用域，需要在识别block时标记它定义是所在的外部的环境，并在执行语句块时扩充这个环境，如果是以执行时指定外部环境的话，就是动态作用域了。
现在，函数调用就等于已经的实现了，因为Stack结构是一种传递参数的常见的可选方案（其他方案Scm最简单的动态实现是用一个指向参数列表的全局变量来传递）。
例如'('tmp 3 define 1 tmp +)和'('inc block 1 + end define 3 inc do)的执行结果都是4，当然结果是4的可能的表达式是写不尽的。
也可考虑当发现变量是block类型时自动执行，这样可以节省掉do操作符，使得自定的操作符和系统提供的操作符使用方法一致。
下面是这个扩展版本的全部代码，注意目前没有实现对于错误表达式的检测（这是相当重要的！！）：
#lang racket
(require racket/mpair)
;;;type stack
(define (make-stack)
 (define stack '())
 (define (empty?)
 (null? stack))
 (define (push item)
 (set! stack (cons item stack)))
 (define (pop)
 (if (empty?)
 '*empty*
 (let ((item (car stack)))
 (set! stack (cdr stack))
 item)))
 (define (dispatch m)
 (case m
 ((push) push)
 ((pop) pop)
 ((empty?) empty?)))
 dispatch)
(define (push! stack item)
 ((stack 'push) item))
(define (pop! stack)
 ((stack 'pop)))
;;;environment
(define (make-env alist env)
 (mcons alist env))
(define (empty-env)
 (mcons (mlist) (mlist)))
(define (empty-sub-env superenv)
 (mcons (mlist) superenv))
(define (env-cell key env)
 (let ((p (massoc key (mcar env))))
 (cond
 (p p)
 ((null? (mcdr env)) #f)
 (else (env-cell key (mcdr env))))))
(define (env-lookup key env)
 (let ((cell (env-cell key env)))
 (if cell
 (mcdr cell)
 #f)))
(define (env-define key value env)
 (let ((p (massoc key (mcar env))))
 (if p
 (set-mcdr! p value)
 (set-mcar! env (mcons (mcons key value) (mcar env))))))
(define (env-setter key value env)
 (let ((cell (env-cell key env)))
 (if cell
 (set-mcdr! cell value)
 (env-define key value env))))
;;;eval-stack:list->'a
(define (eval-stack exp)
 (let ((stack (make-stack))
 (in-block-flag 0)
 (global-env (empty-env))
 )
 ;;stack
 ;...
 ;;block...end
 (define (make-block exp env)
 (list exp env))
 (define (enter-block-flag)
 (push! stack 'block)
 (set! in-block-flag (+ in-block-flag 1)))
 (define (leave-block-flag env)
 (set! in-block-flag (- in-block-flag 1))
 (if (zero? in-block-flag)
 (let loop ((block-exp '()) (nest 1))
 (if (zero? nest)
 (push! stack (make-block (cdr block-exp) env))
 (let ((item (pop! stack)))
 (loop
 (cons item block-exp)
 (cond
 ((eq? item 'block) (- nest 1))
 ((eq? item 'end) (+ nest 1))
 (else nest))))))
 (push! stack 'end)))
 (define (in-block?)
 (not (zero? in-block-flag)))
 ;;statement
 (define (op-doblock)
 (let ((subblock (pop! stack)))
 (eval-stack-impl (car subblock) (empty-sub-env (cadr subblock)))))
 (define (op-define env)
 (let* ((value (pop! stack)) (name (pop! stack)))
 (env-define name value env)))
 (define (op-ifelse)
 (let* ((b2 (pop! stack))(b1 (pop! stack))(bp (pop! stack)))
 (if bp
 (push! stack b1)
 (push! stack b2))
 (op-doblock)))
 ;;operator
 (define (make-bin-op op)
 (lambda ()
 (let* ((b (pop! stack)) (a (pop! stack)))
 (push! stack (op a b)))))
 (define ops
 (list
 (list '+ (make-bin-op +))
 (list '- (make-bin-op -))
 (list '* (make-bin-op *))
 (list '/ (make-bin-op /))
 (list '= (make-bin-op =))
 (list '> (make-bin-op >))
 (list '< (make-bin-op <))
 (list '>= (make-bin-op >=))
 (list '<= (make-bin-op <=))
 (list 'do op-doblock)
 (list 'ifelse op-ifelse)
 ))
 ;;dispatch
 (define (item-symbol? item)
 (and (pair? item) (eq? (car item) 'quote)))
 (define (eval-stack-impl exp env)
 (do ((i exp (cdr i))) ((null? i))
 (let ((item (car i)))
 (cond
 ;;block
 ((eq? item 'block) (enter-block-flag))
 ((eq? item 'end) (leave-block-flag env))
 ((in-block?) (push! stack item))
 ;;env
 ((eq? item 'define) (op-define env))
 ;;op
 ((item-symbol? item) (push! stack (cadr item)))
 ((number? item) (push! stack item))
 ((assoc item ops) => (lambda (x) ((cadr x))))
 ((symbol? item) (push! stack (env-lookup item env)))
 ;;unknown op
 (else (display item) (display '*error*))))))
 ;;main-eval
 (eval-stack-impl exp global-env)
 (pop! stack)))
以上为代码定义部分，对应的执行的结果如下：
(eval-stack '(1 2 + 3 4 5 - * /)) ;=> -1
(eval-stack '(block 1 2 + 3 4 5 - * / end))
(eval-stack '(block 1 2 + 3 4 5 - * / end do)) ;=> -1
(eval-stack '(block 1 2 + end do)) ;=> 3
(eval-stack '(5 1 2 > block 2 + end block 1 + end ifelse)) ;=> 6
(eval-stack '('a 1 1 1 + + define 'b 1 define a b +)) ;=> 4
(eval-stack '('inc block 1 + end define 3 inc do)) ;=> 4
(eval-stack '(block 1 block 2 end end do do -)) ;=> -1
(eval-stack '('a 0 define block 'a 4 define end a)) ;=> 0
(eval-stack '('a 7 define block 'a 5 define a end do a +)) ;=> 12

这篇里赞其功能就扩充到这里了，下面将更换另一个角度来继续修改。
首先是和之前写Scm的Eval一样，这里也将分离解析和执行的过程，其中执行过程会改为使用一个包含更多信息的Stack指令向量。
而且上面的实现依赖的Scheme本身的类型，所以之后会说明如何在静态类型语言中实现这个Stack，以及可以把这个执行序列输出为别的语言。

基本的加减乘数运算还是不变，只是这次改用了向量的形式，例如#(1 2 +)的执行结果是3。由于输入的类型改变了，实现循环的方式也要对应该一下：
(let loop ((pc 0))
 (if (< pc exp-len)
 (begin
 ...
 (loop (+ pc 1)))
 #f))
这个改用区别不大，不过主要的改动是在块语句中，这次改用goto/gosub/return来实现了，而不是用block操作符把遇到的指令直接保存下来。
为了描述方便，这里为我们的指令添加一种中间形式的指令'('here label)来设置标记并用'('here goto)来使用，之后自动把label替换为向量的下标。
此时上面的'(5 1 2 > block 2 + end block 1 + end ifelse))就对应的写为了#(5 1 2 > 't 'f ifelse 'end goto 't label 2 + 'end goto 'f label 1 + 'end label)。
消除label后可以得到更简单的操作符向量#(5 1 2 > 9 13 ifelse 15 goto 2 + 15 goto 1 +)，这样虽然难易书写但可以减少许多执行时候的复杂度。
并且由block转换到label形式，以及由label转换下标形式都是可以编写过程来自动完成的，我们称这个过程为编译（Compile），并且在编译的过程中可以做更多的优化。
这里还有两个操作符没说，其中gosub会push当前下标然后goto到指定下标，其中return则是pop出下标然后goto到这个下标。
这样就又可以来使用函数的调用了，例如#('start goto 'inc label 1 + 'start label 1 'inc gosub)，其中inc执行的操作会把当前stack首元素加一。
在现在这种实现方式下，就不能用同一种操作符来绑定变量和函数了，gosub的执行结果可以往stack中压入数据，但是不能就该这个数据。
为了时现在这个版本在性能上实现优化的同时，要和之前的解释器版本具有一致的功能，毕竟越实现越残疾可就不好了。
那么现在继续改进，由于label操作符会被转化为它存在位置的下标，那么就可以用这个下标来存放变量，定义出了'('there lookup)和'('there set!)这对读写操作。
全局变量按照这样的实现是没有问题，不过函数的局部变量是在它调用的时候产生的，只有这样才能够实现函数的嵌套调用，所以还需要另一种变量存放方式。
不过其实也没什么特别的方式，上面已经看到函数的嵌套调用是和stack结合在一起的，我们也就可以同时也把函数的局部变量也放在Stack上。
那么现在就增加一些stack的操作符，如pop弹出一个元素，dup复制stack首元素，index提取第n个元素压入stack（(0 index)==(dup)），exch交换Stack首的两个元素。
例如之前写过的这样一个递归表达式：
(define (fact x)
 (if (zero? x)
 1
 (* x (fact (- x 1)))))
(fact 4)
对应的在这里就可以写为：
#('start goto 'fact label dup 0 = block pop 1 end block dup 1 - 'fact gosub * end ifelse 'start 4 'fact gosub)
编译操作会把block转化为label，再然后转化为下标的形式。不过现在dup什么的还是不如define直观，于是还是希望有编译define操作符的规则。
例如写成这个样子：
#('start goto 'fact label 'x define x 0 = block 1 end block x x 1 - 'fact gosub * end ifelse exch pop 'start 4 'fact gosub)
并在编译的时候，用index来加偏移量的形式（对每次使用的地点展开的偏移量不一致）来把变量对应的值压入Stack的首部，并在函数末的位置pop掉所传入的所有参数留下要返回的值。
在只用一个返回值的情况下，可以在使用中用一个全局变量在存放返回值，这样在函数末的pop时就不需要exch了，返回值可由return时重新push入Stack。
这里的操作符参考了PostScript的设计，更多的功能和指令可以参考相关的文档，例如这份命令说明 [http://www.math.ubc.ca/~cass/graphics/manual/pdf/a1.ps]。
目前已经有两个地方用来存放变量了，全局区域和局部的Stack区域。接下来还有最后一个区域要说，它是实现之前的解释器中已经实现的嵌套的静态词法作用域所需要的。
于是现在再添加一个malloc指令，它把一个分配一个新的储存空间，并把下标压入Stack中，这个分配的储存空间将由垃圾收集器自动管理。
并且现在也对函数的调用略作修改，参数也由malloc管理而不是放在Stack中，也就是说传入是传入一个list类型（和Scm一样实现，虽然上面没没有写相关的操作符）。
写法还是这样：
#('start goto 'fact label 'x define x 0 = block 1 end block x x 1 - 'fact gosub * end ifelse exch pop 'start 4 'fact gosub)
区别在于define不是为了之后的每次label转移偏离量，而是把这个这个变量移动到malloc分配的空间内，并返回一个固定的下标地址。
虽然看起来这样的修改没有什么变化，而且每次分配和移动操作还有额外的性能消耗，不过修改的后的实现方式可以方便的实现词法闭包。
这一部分有关编译的话题，这次就只做一些说明，不再写完整的代码了。之后介绍Scheme的解释器和编译器的实现的时候，还会回来具体说这个话题。
现在这部分的说明还有一些硬伤，比如函数调用的Stack和传递参数的Stack在一起时，要区分着使用，另一种简单的防范这里问题实现就是两个Stack分开用。
于是在这部分的最后，再对函数的嵌套调用以及嵌套的静态词法作用域再做一些说明吧。
旧的Fortran不允许递归调用，而C语言则不存在嵌套定义函数（性能考虑），所以这里的情况会比他们更加有趣一些。
函数递归调用的情况上面已经说到了，利用stack来传递参数和保存调用点的位置，这个问题可以很好的解决掉。
函数的嵌套定义，例如在函数a里定义了函数b和函数c，那么函数a的名称只能在函数b内获得，当函数a执行时，它的局部变量包括自身的和外部的。
假如函数b只能在函数a内调用，那么外部的局部变量就包括调用b的那个函数a的局部变量，当函数a在被两个调用时，函数a所获得的外部局部变量是函数a不同的执行期Stack。
现在来一步步的分解一个例子执行过程，假如a的环境push，然后push入b的环境，然后b中调用c所以push了c的环境，b需要使用a的环境，c也要使用a的环境。
其中b可以直接用偏离量使用b的变量，不过c所使用的偏离量需要隔开b的环境所占的空间，c不需要关心b的环境。
所以，在嵌套函数定义的调用时中需要把保存一个指向外部的局部变量的的基准（base）偏移量，在使用偏移量的时候加入这个基准值。
不过由于函数可以作为函数的返回值，在函数返回的时候Stack上的变量就不存在了，其实这个问题上面已经解决了，就是malloc的引入。
也就是说上面的嵌套环境的方式不变，而变量获得的不是stack上的地址，而是额外分配地址，变量在Stack上只做引用（或者称指针）的作用。
现在，无仅仅是Stack模型上的语言的转化，利用之前的中缀转换过程来修改，也可把Scheme代码也转换到这样的模型上来。
在现实中的编译过程中可以先把选代码转换为特定模型下的中间代码，然后再继续转换为目标代码。这样看似让编译操作多了一个过程，但是可以让这两个步骤都得到简化。
常见的中间代码模型如p-code（用stack保存中间结果）以及Three address code（运算时带寄存器，每条指令一般（最多）三个参数），两者之间可以很方便的实现互相转换。

本篇的最后，来说明如何在静态类型的语言中实现这样一个基于Stack的编程语言模型，常见的语言ASM/C/C++/Java/Ocaml都属于静态类型的语言。
就整个解释器和编译器的实现逻辑来说，和上面的Scheme没有多少差异，主要的区别在于类型系统上面，下面将针对每种语言相当简要的说明一下：
首先是OCaml语言，它是一种静态类型的函数式语言，利用到的特性是ADT（Algebraic data type）：
type operator = Add | Sub | Mul | Div;;
type stack_item=Op of operator | Int of int | Float of float | Symbol of string;;
exception Type_failure;
之后用macth with来匹配操作对应的功能。
接下来是C语言，它通常是实现此类代码的首选语言，用到的特性是enum和union
enum op_type {Add,Sub,Mul,Div};
enum stack_item_type {Op,Int,Float,Symbol};
struct stack_item {
 enum stack_item_type t;
 union {
 enum op_type op_v;
 int int_v;
 float float_v;
 char* symbol;
 }
}
之后用switch case来匹配操作对应的功能。
再接下来是Java语句，它是一个面向对象的语言，可以使用类的继承来实现：
public class TypeError extends RuntimeException{}
abstract class StackItem {
 public void run(Stack s);
 public int getInt(){
 throw TypeError();
 }
 public bool isInt(){
 return false;
 }
 public bool isOp(){
 return false;
 }
}
public class Int extends StackItem{
 private int value;
 public Int(int value){
 this.value=value;
 }
 public int getInt(){
 return this.value
 }
 public bool isInt(){
 return true;
 }
 public void run(Stack stack){
 stack.push(this)
 }
}
public class Add extends StackItem{
 public bool isOp(){
 return true;
 }
 public void run(Stack stack){
 stack.push(new Int(pop().getInt()+pop().getInt()));
 }
}
虽然写法上看起来不同，不过其实之间的差异不大。
如果要实现Scheme中Pair类型，也可以类似的来写：
首先是Ocaml版本 type pair=Cons of {car:stack_item;cdr:pair} | Nil;;，
然后是C的版本 struct pair {enum stack_item_type car_t;truct stack_item car;struct pair* cdr;s};，
最后是Java版本
public class Pair {
 private StackItem car;
 private Pair car;
 Pair(tackItem car,tackItem cdr){
 this.car=car;
 this.cdr=cdr
 }
 public StackItem getCar(){
 return this.car
 }
 public Pair getCdr(){
 return this.cdr
 }
}
注意，这里不是语言的比较，而是本文实现的东西在任何一种语言中是都可以实现的。
这里把Java版本虽然写得繁琐的一些，但是良好的面向对象设计可以使得实现代码像吹气球一样有效率的完成。
当代码的规模较大的时候，有条理的结构相当于给高层建筑一个坚强的地基，使得功能的实现可以进行下去。
而在Scheme这样的语言中，可以把过程根据它处理的类型划分为代码块，简单的说就是运用组合加抽象的原则。

最后的最后，补充一下前面有一篇说笛卡尔积的时候的东西。
两个元素的笛卡尔积在这里就是根据两个列表生成一系列二元组。
(define (pairs s t)
 (if (null? s))
 '()
 (append
 (map (lambda (i) (list (car s) i)) t)
 (pairs (cdr s) t))))
(pairs '(1 2 3) '(4 5 6))
;=> ((1 4) (1 5) (1 6) (2 4) (2 5) (2 6) (3 4) (3 5) (3 6))
可以作用到两个列表上了，就自然地也可以扩展到三个列表，以及n个列表上了。
此外，笛卡尔积有如下三个性质：
1.任意集合与空集的笛卡尔积是空集，
2.笛卡儿积不满足交换律和结合律，
3.笛卡儿积对集合的并集和交集满足分配律。

* Scheme Toy #31 Alg
ee.zsy 2011年05月03日 22:43

虽然这里的大部分内容是用Scheme语言来描述，但是这只是表示它是这里描述问题所用的问题，而不是所描述的问题本身。

从Scheme语言的背景来说的话，有三篇很值得一看的Papers，它们都涉及对运算过程的符号化表达：
Turing,A. M.. "On Computable Numbers,with an Application to the Entscheidungsproblem".
John McCarthy. "Recursive Functions of Symbolic Expressions and Their Computation by Machine,Part I"
Gerald Jay Sussman and Guy Lewis Steele,Jr.. "Scheme: An Interpreter for Extended Lambda Calculus"
它们都可以通过网络自由地获得pdf的存档，地址对应如下：
http://www.comlab.ox.ac.uk/activities/ieg/e-library/sources/tp2-ie.pdf
http://www-formal.stanford.edu/jmc/recursive.pdf
http://repository.readscheme.org/ftp/papers/ai-lab-pubs/AIM-349.pdf

以下的内容将围绕计算过程中数据和状态的变化来说明，淡化了作为语言特性所提供的组合和抽象两方面的机制。

先以一个简单的问题Longest increasing subsequence最长递增子序列为例：
对于给定的可排序元素组成的序列，返回其中最常的递增子序列（由序列的选定元素组成的序列）。
例如对于数列0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15,…对应的LIS是0,2,6,9,13,15。
解决问题的思路是运用有向非循环图的模型将节点从左至右依次排列，则每个节点的LIS只和它左侧能到达它的节点有关，并且是固定的（不一定唯一，但是路线是固定的）。
于是就得到了这样的关系，到达第n项的LIS是由到达项数小于该项且值也小于该项的项的LIS加上该项后组成的序列，对于所要的结果便是该项为末项的情况。
现在问题本身的描述已经有了，对问题抽象出来的模型也已经完成，下面的问题是如何把它变成计算机可以理解的代码。
首先，上面所建立的关系是lis[n]与lis[1...n-1]的关系，并且lis[1]是可以直接得出结论的（下标从1开始），可以通过直接求解得到需要的结论。
这样，已经可以得到需要的结果了，不过另一方面，不论是函数的求值过程，还是命令的一次执行，都暗含着其中顺序，现在就来看解决这个问题中顺序方面的策略。
因为每一项要根据比它小的项（有向图中能到达该节点的节点的集合）得出结论，这里也就可以对这个数列按照项数从小到大的顺序来执行计算，值得在计算一项lis的时候已经知道了它所依赖的lis的值。
此外，由给定的可排序元素组成的数列，我们可以比较其中任意两个元素的大小关系。当存在三项abc已知ab满足递增关系时，当bc满足递增关系时，那么ac也一定满足递增关系，并且一定没有序列abc长。
于是现在的计算策略是依照项数从小到大，当计算第n项时比较它全部项数小于它的项，找到递增序列长度的最大值。
而下面的写法也一样的，依照项数从小到大的顺序，当计算到n项时用自己的lis标记全部项数大于它的项，如果发现标记不够好则更新标记。
在实现中，需要保存计算过程中每个节点的当前状态，这里使用了一张一维（不一定总是一维的）的表，由项数对应到一个最长递增子序列。
(define (lis seq)
 (let* ((seq-length (length seq))
 (seq-vector (list->vector seq))
 (lis-vector (make-vector seq-length '(0 ()))))
 (vector-set! lis-vector 0 (list 1 (list (car seq))))
 (do ((i 0 (+ i 1)))
 ((= i seq-length) (reverse (cadr (vector-ref lis-vector (- i 1)))))
 (do ((j (+ i 1) (+ j 1)))((= j seq-length))
 (let ((a (vector-ref seq-vector i))
 (b (vector-ref seq-vector j))
 (p (vector-ref lis-vector i))
 (q (vector-ref lis-vector j)))
 (if (and (< a b) (> (+ 1 (car p)) (car q)))
 (vector-set! lis-vector j (list (+ (car p) 1) (cons b (cadr p))))))))))
(lis '(0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15)) ;=> (0 4 6 9 13 15)
现在来看这个计算过程，对于有n项的序列，遍历每项时对于项数i，再需要遍历[i+1,n]项，总的访问的次数构成等差数列求和的关系。
也就是这个计算过程的时间复杂度与输入的规模呈平方关系，空间的消耗则是所用到的于输入数据规模相同的一维数组。
利用数学归纳法可以证明以上过程正确，并且以上的过程对于所有能转化为有向非循环图的模型的问题，都可以求出其中的最长路劲所代表的结果。
继续改进的话，可以用一个二维表来表示计算过程，下标的点对及其对应的值代表序列前x项达到递增序列长度y时末项的最小值z。
由于对于固定的x的值y呈递增关系，并且第x行的所有列仅有一个元素与x-1行不同，于是利用分治的方法可以把时间复杂度优化到nlogn。
并且由于计算了x行时，第x-1行已经不需要了，所以没有增加空间复杂度，用一个一维数组来实现依然是可行的。

下面再举另一个也很简单的问题，解等式可以用到的数值算法Newton's method牛顿迭代法：
对方程f(x)=0，当f'连续且零点x周围一定范围内是孤立的，则区这个范围内的x0，
有x(n+1)=x(n)-f(x(n))/f'(x(n))，当n越大时x将越趋近于方程的根。
这里以开方运算为例，方程是f(x)=x^2-y=0，求x的值，则x的零点便是是y的平方根。
其中f'(x)=2x，所以x(n+1)=x(n)-(x(n)^2-y)/2x(n)=(x(n)+y/x(n))/2。
对应写出的Scm表达式为(define (next x y) (/ (+ x (/ y x)) 2))，
当x(n+1)-x(n)足够小的时候，迭代终止，这一过程可以写为：
(define (sqrt1 y)
 (define square (exact->inexact y))
 (define (next x y) (/ (+ x (/ y x)) 2.0))
 (define prec .01)
 (let iter ((old-v 2)(new-v 1))
 (if (< (abs(- old-v new-v)) prec)
 new-v
 (iter new-v (next new-v y)))))
(sqrt1 3e21) ;=> 54772255750.51662
执行的结果表示3e21的平方根近似等于54772255750.51662
这里利用了计算在数值计算上的性能优势，很方便的利用数值算法和数值方法解决了一些数的计算问题。
在编写代码时，可以直接把迭代表达式直接写为一个迭代过程，并判断终止迭代的条件满足时返回值。

现在可以看到，问题模型、编程语言以及人这三者之间存在着密不可分的关系：
编程语言是一种形式语言，它可以用来描述一个计算过程（可以是数值计算，也可以是符号计算），并通常可以让计算机执行这个过程。
其中人所起到的作用是，把现实中的问题建立为可计算的模型，用某种形式语言将计算的方法描述出来，使得人与人之间可以识别并交流。
并同时细化计算过程的次序（有时可以有建立算法计算次序用的算法）和储存所用的结构，优化其时间和空间复杂度，交予机器求解。
最好的期望是问题可以肯定能在多项式时间内得到求解，不过以上的内容不单单于计算机使用，算法执行的过程也可以用机械或者电路来实现。
不论是数学表达式，或是图形图标，或者计算机代码，都可看作是抽象于问题的模型的存在，并依附于某种工具来将解决的方法应用到具体的问题上。
如果一定要谈论Lisp有什么特别的话，它强调是通过抽象而建立起来的，出于人的认知，而不仅仅是模拟机器的执行过程。所以思维与模型之间尽量波长一致（？），并且特性层次分明协调。

之前篇目的标号有个空缺，这篇来占位用。

* Scheme Toy #34.5 CPS
ee.zsy 2011年05月03日 22:44

这篇的内容来说一些Scheme闭包的代码的变换，这些变换对于理解语言本身以及实现解释器和编译器都是有所帮助的。
为说明方便，下面文字将会围绕示例代码展开解释，展示不同写法的差异，并将其中的规则流程写为可运行的表达式。

首先从最简单的说起，下面是使用lambda表达式作为操作符的情况，相当于函数调用。
对于代码((lambda (x y) (+ x y)) 1 2)，这相当于执行了(+ 1 2)，计算结果是3。
因为lambda的第一个参数是列表，所以可以等价的写为
(apply (lambda arg (+ (car arg) (cadr arg))) '(1 2))。
这里所有的操作数写作了一个列表，充当了lambda的参数（有且只有一个）。
现在可以定义出如下根据名称解析出参数的过程：
(define (get-args arg-list name)
 (if (pair? arg-list)
 (list
 'lambda 'x
 (let loop ((args arg-list) (path 'x))
 (cond
 ((eq? args name) path)
 ((pair? args)
 (if (eq? (car args) name)
 (list 'car path)
 (loop (cdr args) (list 'cdr path))))
 (else #f))))
 #f))
执行如下代码
(get-args '(x y . args) 'x) ;=> (lambda x (car x))
(get-args '(x y . args) 'y) ;=> (lambda x (car (cdr x)))
(get-args '(x y . args) 'z) ;=> (lambda x #f)
(get-args '(x y . args) 'args) ;=> (lambda x (cdr (cdr x)))
考虑之前写过的eval过程，函数调用时可以将参数名称和实际调用的参数存为关联列表。
在执行的函数体内遇到变量名的时候，在这个关联列表中查找到符号所对应的值，并把这个值用于计算。

接下来，将镜头拉远，可以看见我们的lambda不是孤立存在的，它存在于别的lambda之中。
下面的adder函数接受一个参数，返回一个lambda表达式，然后用这个返回值继续求值。
代码(define (make-adder add) (lambda (x y) (add x y)))执行((make-adder +) 1 2)将返回3。
值得注意的是这里不能直接展开为((lambda (x y) (add x y)) 1 2)这样其中的add是未定义的。
现在我们有两种方法去查找这个函数体内用到的未以参数形式绑定的符号，一种是在执行时，一种是在定义时。
前者称为动态作用域，相当于为lambda表达式增加了一个表示环境中变量的参数，改写为：
((lambda (x y add) (add x y)) 1 2 +)或者更抽象些是((lambda (x y env) ((lookup env 'add) x y)) 1 2 env)。
回想之前曾写过有一个env参数的eval，这里就相当于eval把自己的env原封不动的传给了它所调用的lambda表达式。
不过事实上Scheme所用的是静态词法作用域，和上面所给的描述是不一致的，自由变量的绑定不会受执行环境影响。
当用来定义procedure的lambda被执行时，它除了将自己的参数保存下来，也要将此时（定义的时候）的env保存下来。
也就是说在eval到lambda语句的时候把此时的env和lambda的参数以及函数体的内容保存一起，在eval到调用时只提供参数。
保存整个env对于之前所写的eval过程是有必要的，因为lookup对能都找到的任意符号都有可能找到。
不过如果将解析和执行两部分隔离的话，显然也可以只保存lambda里用到的env变量的引用，就像上一个段落一样写为env-list。
当函数的参数的调用方式固定的时候，可以把arg和env都实现为向量，直接用下标在常数时间里获得对应的值。
现在可以利用以上的描述，将Scheme中闭包，用不支持闭包的语言，例如C语言来写：
/* (define (make-adder add value) (lambda (x) (add value x))) ((make-adder + 1) 2) */
#include <stdio.h>
typedef int(*fun_add)(int,int);
int pri_add(int x,int y){
return x+y;
}
struct _adder_object_impl{
fun_add fun;
int val;
};
typedef struct _adder_object_impl adder_object;
int apply_adder(adder_object adder,int x){
return adder.fun(adder.val,x);
}
adder_object make_adder(fun_add add,int value){
adder_object closure;
closure.fun=add;
closure.val=value;
return closure;
}
int main(int argc, char** argv){
printf("%d\n",apply_adder(make_adder(&pri_add,1),2));
return 0;
}
执行的结果是输出3，代码中adder_object可以作为函数的返回值，不过adder_object本身不是闭包。
闭包有函数和环境两部分组成，这里前者是apply_adder后者是adder_object，它们功能组成了闭包。
我们可以创建一个叫Closure的结构，它包含指向apply_adder的指针并储存adder_object结构。
调用闭包的过程，是把闭包的参数和储存定义时环境信息的adder_object一起交给apply_adder执行。
这也就是说和Scheme语言的版本做比较，上述的改写方式我们的代码实际是写在apply_adder里面的。
并且由于scm的变量是动态分配的（也就是说用mallc），env里面保存的应该是指针，并有垃圾收集器负责free。
或者用C++的一点语法便利，把代码写出来更加直观一点：
#include <iostream>
using namespace std;
typedef int(*fun_add)(int, int);
int pri_add(int x, int y) {
return x + y;
}
class AdderClosure {
private:
fun_add fun;
int val;
AdderClosure(fun_add add, int value) :
 fun(add), val(value) {
}
public:
static AdderClosure create(fun_add add, int value) {
 return AdderClosure(add, value);
}
int operator()(int x) {
 return this->fun(this->val, x);
}
};
int main() {
cout << AdderClosure::create(pri_add, 1)(2) << endl;
return 0;
}
或者用模板来写：
#include <iostream>
#include <functional>
using namespace std;
template<class Add,int Val>
class AdderClosure {
private:
public:
int operator()(int x) {
 return Add()(Val, x);
}
};
int main() {
cout << AdderClosure<plus<int>, 1>()(2) << endl;
return 0;
}
现在的改写中存在一个假设，就是尽可能的把函数调用写为静态类型，不同的闭包也就都按照不同的类型处理了。
对于部分Scheme代码的改写而言，这样的处理方式是可以的，并且性能最优。不过因为缺少多态，使得不总能这样。
要特别注意的是上面的C语言代码中的make_adder可以调用多次，返回的是不同的闭包，用起来相当于不同的函数。
不过这些闭包实现上仍只是同样一份使用了同一份apply代码，是因为闭包间env变量的不同使得产生不同的表现效果。
最后写到的基于模板的实现，虽然也相当于不同的参数返回不同的函数对象，不过这些函数对象之间是编译时生成了不同的类型。

以上的代码看起来可以工作了，不过用来描述Scheme的运行机制的话还是有些并不一致的地方（切记以上部分属于错误的尝试！）。
不过把嵌套定义的闭包用平坦的结构来表示依然是这里的目标，所以上面的内容还算是顺利的开头。
那么现在就再回到Scheme语言中，看看它的闭包有什么特性，以便继续修改上述的改写规则。
首先，闭包可以作为变量传递，其次闭包可以访问并修改定义位置的能访问的变量。来看这么段代码：
(define (make-counter)
 (let ((count 0))
 (lambda ()
 (set! count (+ count 1))
 count)))
(define c (make-counter))
(c)
(c)
(c)
(c)
以下用Java来写，用到了垃圾收集。不过代码按照C的风格来写，函数指针用仅有一个方法的类来表示（并且不许用隐含的this指针）。
import java.util.ArrayList;
public class CopyOfCopyOfClosureDemo {
static final class Variable {
 volatile Object ref;
 @Override
 public String toString() {
 return this.ref.toString();
 }
 private Variable(Object ref) {
 this.ref = ref;
 }
 public Object get() {
 return ref;
 }
 public void set(Object ref) {
 this.ref = ref;
 }
 public static Variable of(Object ref) {
 return new Variable(ref);
 }
 public Variable copy() {
 return new Variable(this.get());
 }
}
static interface Procedure {
 Variable lambda(ArrayList<Variable> args);
}
static interface Lambda {
 Variable body(ArrayList<Variable> args, ArrayList<Variable> env);
}
static final class Closure implements Procedure {
 private final Lambda lmb;
 private final ArrayList<Variable> env;
 private Closure(Lambda lambdaImpl, Variable... envVars) {
 this.lmb = lambdaImpl;
 this.env = new ArrayList<Variable>();
 for (Variable variable : envVars) {
 this.env.add(variable);
 }
 }
 @Override
 public final Variable lambda(ArrayList<Variable> args) {
 return this.lmb.body(args, this.env);
 }
 public static final Variable make(Lambda lambdaImpl,
 Variable... envVars) {
 return Variable.of(new Closure(lambdaImpl, envVars));
 }
}
static final Variable apply(Variable proc, Variable... args) {
 ArrayList<Variable> lambdaArgs;
 if (args == null) {
 lambdaArgs = null;
 } else {
 lambdaArgs = new ArrayList<Variable>();
 for (Variable variable : args) {
 lambdaArgs.add(variable.copy());
 }
 }
 if (proc.get() instanceof Procedure) {
 Procedure lambdaProc = (Procedure) proc.get();
 return lambdaProc.lambda(lambdaArgs);
 } else {
 throw new RuntimeException();
 }
}
static final Variable[] nil = null;
/** demo */
public static void main(String[] args) {
 Variable makeCounter = Variable.of(new Procedure() {
 @Override
 public Variable lambda(ArrayList<Variable> args) {
 Variable varN=args.get(0);
 return Closure.make(new Lambda() {
 @Override
 public Variable body(ArrayList<Variable> args,
 ArrayList<Variable> env) {
 int oldCount = ((Integer) env.get(0).get()).intValue();
 int newCount = oldCount + 1;
 env.get(0).set(Integer.valueOf(newCount));
 return Variable.of(newCount);
 }
 }, varN);
 }
 });
 Variable zero = Variable.of(Integer.valueOf(0));
 Variable c = apply(makeCounter, zero);
 Variable d = apply(makeCounter, zero);
 System.out.print(apply(c, nil));
 System.out.print(apply(c, nil));
 System.out.print(apply(c, nil));
 System.out.print(apply(c, nil));
 System.out.print(apply(c, nil));
 System.out.print(apply(d, nil));
 System.out.print(apply(d, nil));
 System.out.print(apply(d, nil));
 System.out.print(apply(d, nil));
 System.out.print(apply(d, nil));
 System.out.print(zero);
 }
}
为了使得代码尽可能的和C/C++提供的特性一致以方便互相改写，这段代码中class不可以extends全标记为final。
这样class就充当了C语言中的struct使用，并且interface充当了C语言中的函数指针来使用，差异在于有了垃圾收集。
上面的代码执行后的输出是123450，其中的Procedure表示一个过程，其实变量makeCounter引用了一个Procedure的实现。
上面的apply过程是call-by-value，这对于允许副作用时会影响到代码的执行结果，同时这也是实现词法闭包必不可少的环节。
其中Variable.of创建一个引用某对象的变量，而Variable.copy创建一个和当前变量指向同一个对象的变量。
当程序中需要改变变量的时候（执行set!），它改变的是让当前变量指向新的对象，并假设指向的对象是不可变的。
这里是使用了Java的Integer对象（它也是对int的封装），在允许union的语言中，也可以直接实现为Variable的一个成员。
例如表达式(define a 1) (define b a)，变量a引用对象1变量b指向对象a所指向的对象，此时是同一个1（这里是同一个对象，用联合的话则不是）。
而当执行了(set! a 2)之后，变量a引用了新的整数对象2，现在变量b仍然引用了原本的整形对象1，此时这两个变量是不同的值。
而有些语句会直接修改对象本身，如set-car!。当(define a (list 1 2)) (define b a)执行后，变量a和变量b引用了同一个列表。
此时执行(set-car! a 3)之后，这个列表的首元素被修改了，所以此时查询变量a和变量b后的结构都是得到了同一个修改后的列表。
类似的例子是对于(define tmp (list 1 2))，执行(apply (lambda x (set-car! x 3)) tmp)后tmp不会改变。
而与之相区别的是((lambda (x) (set-car! x 3)) tmp)，它会把tmp修改为'(3 2)，因为是直接修改了tmp所引用的对象。
当apply调用了makeCounter的时候call-by-value的过程为每个参数创建了一份引用了同一个对象的变量。
现在调用函数的参数和所实现的函数得到是引用（或者说指向）了相同的对象，所以两者所代表的数据的内容是一致的。
不过当自己函数的实现里面改变了某个变量的值（其实就是让它指向了另一个对象，可能这个对象是新创建），它不影响原本作为参数位置的使用的变量的引用。
也就是说赋值语句的意思是改变变量所引用的东西，结合C语言中场景可以说是改变了指针本身，而不是改变了指针指向的内存的值。
函数makeCounter中创建了一个闭包，闭包实现了Procedure界面，由一个语句块和一个表示定义时环境的变量组成。
以上代码中的嵌套定义只是为了写起来好看一些，其实是完全没有必要的（而且最好不要写成嵌套），况且这里人为约束Lambda界面的实现不允许定义成员和访问外部变量。
所以嵌套定义时对于外部作用域外部作用域的引用也是不使用，况且Java中对外部作用的变量的使用也仅限于final和field两种也能可以编译时展开的类型。
这里是希望执行中变量传递都通过Lambda.body方法的参数来进行，这样的话可以把平坦的实现为一个C语言中的函数，这符合之前的期望。
上面Closure类相当于包含两个元素组成的结构，以及定义了一些使用这个结构的函数。其中这两个元素分别表示执行的代码和闭包定义时的环境。
执行的代码就相当于C语言中的函数，这里实现为只有一个方法的Static类。在闭包被调用的时候，需要把调用的参数和闭包定义时的环境都传给这个函数。
这里要注意的是闭包在定义的位置把闭包所需要的外部变量储存为一个列表，闭包获得的是直接对Variable对象的引用。
当闭包中要修改外部变量的值的时候，它是改变了闭包所引用的Variable对象中所储存的引用，（这里并没有新的Variable对象被创建）。
此时定义闭包的函数和闭包自身的函数中是引用了同一个Variable对象，对Variable的修改（改变Variable.ref）会同时在两处（甚至多个闭包中体现出变化）。
可以看这么一段表达式(define (f n) (cons (lambda () (set! n (+ n 1))) (lambda () n)))，返回了两个闭包的点对。
执行(define g (f 0)) ((car g)) ((cdr g))获得的结果是1，是因为在调用(f 0)的时候，创建了一个变量n，并同时这两个闭包都同时引用了这个变量。
对这个变量n的垃圾收集，发生在使用这个变量的这两个闭包都要可以垃圾收集的时候，Variable对象和Variable对象所引用的对象都是动态分配的，这个以后再来说明。
这里的类Variable变量表示对某对象的引用，它可以引用Ocject对象，也可以引用Object的子类，在使用时需要判断类型，并将类型声明为具体的类型后再使用。
这里的Object的子类可以是整数，可以是字符串，可以是点对等等Scm中的各种类型的并集，在使用Variable.get的时候必然涉及到类型的转换。
动态分配的对象的类型转换在Scm这个动态语言的解释过程中是会存在的（除非编译时优化消除掉类型信息），就有必要对类型正误和类型转换进行判断。
当存在类型错误是，需要向用户报告信息，这是Scm语言的一部分，最好不要和Java本身类型相关的运行时错误混在一起实现。
类型可以用instanceof判断，也可以用enum来标记额外的信息，如果是C语言的话枚举加联合，C++的Dy_cast不大提倡使用。
一些函数，例如+求和，会根据类型的不同使用不同的内部实现，例如作用在整数、浮点数、复数上时加法就是用的不同的实现。
从实现上简单的角度说，每个env中有一个指向外层env的引用，函数的调用过程就是再创建一层新的env，并外层的引用指向定义时的env。
不过在多少次调用一个函数创建闭包，可以仅仅是每次调用工厂函数的时候创建了不同的env，而闭包中的lambda表达式的代码可以使用同一份。
env可以在运行时展开，也可以在编译时展开，上面的代码就是写出的手工编译时展开的情况，之后可交给固定的过程进行。
还有就是，以上没考虑多线程时候的加锁，虽然说在Java中也就是给若干方法标记一下synchronized的事情，这里是需要对有成员变量的类做这样的考虑。

加入按照之前一篇把Scheme语句的执行代码改写成基于Stack的执行序列的话，可以进一步按照如下的方式看待闭包的调用过程。
由lambda所定义的过程的body部分是一个语句序列，在它的执行过程中需要用到若干变量，包括上面说到的参数列表args和环境env。
此外还有保存调用者地址的continue，函数在返回的时候，可以把返回值存放在某个变量中如var，然后跳到调用者保存的地址执行。
如果在这个语句序列中需要调用其他的函数的话，它需要把自己的这些参数(args和env外加另外几个)保存到Stack中（不可能存在局部变量）。
然后就可以构建所要调用的函数的参数列表和环境，由于用cons来构建列表，调用其他的函数所用的参数列表args通常由右至左运算。
当前的地址保存于continue中，以便函数执行之后返回到这里，并在这个时候获取所调用的函数的返回值，目前是存于var中。
其中env变量可以保存它所用到的其他env外加偏移量，也可以在编译的时候转化为直接转递具体所用到的变量的引用，以减少不必要的引用。
当遇到尾递归的情况，函数调用了下一个函数，参数列表需要为下一个函数调用准备好的，这里的区别在于不需要保护当前的参数列表供自己继续执行了。
并且continue的值依然使用调用者获得的，以便下一层调用直接返回上一层的调用位置，尾递归的这一层不占用在Stack上保存信息的空间。
于是现在终于到了本篇的重点之处CPS（Continuation-Passing Style），它的意思是说例如(define (inc x) (+ x 1))调用inc的时候会接下来使用它的返回值。
比如(+ 1 (inc 1))中(inc 1)的延续就是用它的返回值去调用(+ 1 <(inc 1)的返回值>)，或者写为(lambda (ret) (+ 1 ret))。
利用尾递归可以改写上述的代码执行过程，不再用某个全局变量来存放函数的返回值，而是直接用这个返回值作为参数去调用它的延续。
在这里的例子就是(define (inc x cont) （cont (+ x 1))，这里(+ 1 (inc 1))也就变成了(inc 1 (lambda (ret) (+ 1 ret)))。
这里inc的第二个参数是一个闭包，闭包是由代码的地址和环境向量两部分组成，整个闭包作为一个参数传递给被调用函数。
或者用单独的continue来传递这个参数也行但不必要，而环境向量本也可以作为参数列表的一部分，现在的做法是因为保存闭包的时候要单独保存环境向量。
现在这里的调用延续的过程，就是用一个参数去以尾递归的方式调用函数的过程，不需要保存当前的返回被调用处的continue以及参数列表到Stack上了。
现在，参数环境以及延续（这个是新增的）是构成闭包调用的三个组成部件，Stack已经不需要起函数调用保护现场作用，函数调用只留下简单的goto语句。
每次函数调用时，它的参数可以是新创建的闭包，需要把闭包要执行的代码地址以及env保存在Heap上，这些数据还是会随着函数的嵌套调用增长的。
下面继续以一些表达式为例来演示一些代码的编译方式，以及对应的CPS变换的过程，其实SICP的4.3节正是说的这个内容，并有更完整的代码。
为了方便描述，将使用表格形式的伪代码来说明，并且可以看作大部分程序语言中的switch case语句所表示的整数到代码的映射来供执行。
片段一，函数返回闭包：
(define (make-counter count)
 (lambda ()
 (set! count (+ count 1))
 count))
(define c (make-counter 0))
(c)(c)(c)(c)
s0 goto s4;
s1 val=[s2;[&arg[0]]];goto cont;
s2 *env[0]=*env[0]+1;goto cont;
s3 cont=s4;goto s3;
s4 cont=s5;goto val;
s5 cont=s6;goto val;
s6 cont=s7;goto val;
片段二，调用函数：
(define (inc x) (+ x 1))
(+ 1 (inc 1))
s0 goto s2;
s1 val=arg[0]+1;goto cont;
s2 cont=s3;arg=[1];goto s1;
s3 display val;
片段三，CPS形式：
(define (inc x cont) （cont (+ x 1))
(inc 1 (lambda (ret) (+ 1 ret)))
s0 goto s2;
s1 arg,cont=[arg[0]+1],arg[1];goto cont;
s2 arg=[1,s3];goto s1;
s3 display arg[0]
这里的原始过程"+"没有实现为CPS，即没有带额外的参数表示延续，实现为CPS也是可以的。
片段四，递归求阶乘：
(define (factorial n)
 (if (= n 0)
 1
 (* (factorial (- n 1)) n)))
(display (factorial 6))
s0 goto s5;
s1 if arg[0]==0 goto s4
s2 push arg,cont;cont=s3;goto s1;
s3 pop arg,cont;val=arg[0]*val;goto cont;
s4 val=1;goto cont;
s5 arg=[6];cont=s6;goto s1;
s6 display val;
片段五，对应的CPS改写：
(define (factorial n cont)
 (if (= n 0)
 (cont 1)
 (factorial (- n 1) (lambda (x) (cont (* x n))))))
(factorial 6 display)
s0 goto s5;
s1 if arg[0]==0 goto s3
s2 arg=[(arg[0]-1),(cont=s4,env=(&arg[0],&arg[1]))] goto s1;
s3 arg,cont=[1],arg[1]->cont;goto cont;
s4 arg,cont=arg[0]*arg[1]->env[0],arg[1]->env[1];goto cont;
s5 arg=[6,(s6)];goto s2;
s6 display arg[0];
上面cont仅仅书写所用，其可以指向一个地址，也可能是闭包（地址加环境向量）。
传递arg的时候，看作同时传递arg,cont两个变量也是一样的（上面的arg[1]变为cont）。
使用了CPS的好处是，可以把延续保存在变量中，对应Scm中call/cc所提供的功能。

那么接下来，就可以去完成一个Scheme实现了，其包括下列组件：
1.内置的类型（包括整数/列表...），
2.reader读取sexp，转化为内置的类型，
3.eval解释运行所读取的sexp，
4.把所读的sexp转换为中间代码，
5.解释运行中间代码，
6.将中间代码转换为其他语言（如C语言）。
其中可以自己实现自己，即用Scheme语言所写的代码把Scheme语言代码转化（编译）为C语言的代码。
如果是转换为C语言的话，Scm的类型以及动态内存管理（垃圾收集）还是需要完成额外的实现的。

* Scheme Toy #34.7 GC
ee.zsy 2011年05月03日 22:45

接着上一篇说，这里是关于Scheme的内存管理的实现的，Lisp语言一个显著的特征是变量可以都在Heap上。
这不同于C语言全局变量是Static，局部变量及参数传递在Stack上，动态变量在Heap上（需要自己free）
实现不等于语言本身，就像Java中Object全部在heap上而C++中Objec也可以在Heap上，这里所说的是Lisp较常见的实现方式。
事实上从性能考虑，把局部变量放在Stack上通常会获得更好的执行效率，将Lisp实现为这样也行。
如果用Stack的话，实现Scheme的延续就得做些改变（比如复制整个Stack），从简单起见，下面还是将写全动态的实现。
如果内存全部的运行时动态分配的话，如果不希望总手动free，就需要一个自动的垃圾收集机制（事实上手动过程也得写一个简单的gc了）。
垃圾收集GarbageCollection起源于Lisp，并随着Java的流行得到普及，在动态类型的脚本语言中如Python垃圾收集也是必备的机制。
这里将以对一些最简单代码的演示为主，将不涉及其中的原理或者是对应用场合的考虑，也不会涉及到较复杂的情形。

首先说Reference-counting引用计数。这里用Reference类表示一个引用，用Represent类存放指向所引用对象的指针。
Represent类中用count表示引用自己的Reference的个数，Represent实例右使用它的Reference类负责管理创建和删除。
在Reference类的实例析构的时候，它会让Represent的count--，并当Represent的count==0时delete这个Represent。
示例代码如下：
#include <iostream>
using namespace std;
template<class T>
class Reference {
struct Represent {
 int count;
 T* pointer;
 Represent(T* object) :
 count(1), pointer(object) {
 }
 ~Represent() {
 delete pointer;
 cout << "rep freed here" << endl;
 }
 int link() {
 cout << "count will be " << count + 1 << endl;
 return ++count;
 }
 int unlink() {
 cout << "count will be " << count - 1 << endl;
 return --count;
 }
private:
 Represent(const Represent&);
 Represent& operator =(const Represent&);
};
Represent* rep;
Reference() {
}
public:
Reference(T* object) :
 rep(new Represent(object)) {
}
Reference(const Reference<T>& ref) :
 rep(ref.rep) {
 rep->link();
}
Reference<T>& operator =(const Reference<T>& newRef) {
 newRef.rep->link();
 if (rep->unlink() == 0)
 delete rep;
 rep = newRef.rep;
 return *this;
}
~Reference() {
 if (rep->unlink() == 0) {
 delete rep;
 }
}
T* operator ->() {
 return this->rep->pointer;
}
};
class Integer {
int n;
public:
Integer(int x) :
 n(x) {
}
int intValue() {
 return n;
}
};
template<class T>
void foo(Reference<T> x) {
cout << x->intValue() << endl;
}
int main() {
Reference<Integer> r1(new Integer(6));
Reference<Integer> r2(r1);
Reference<Integer> r3(r1);
Reference<Integer> r4 = r3;
r3 = r4;
cout << r1->intValue() << endl;
cout << r2->intValue() << endl;
cout << r3->intValue() << endl;
foo(r3);
return 0;
}

执行显示：
count will be 2
count will be 3
count will be 4
count will be 5
count will be 4
6
6
6
count will be 5
6
count will be 4
count will be 3
count will be 2
count will be 1
count will be 0
rep freed here
引用计数是一种较为简单的自动内存管理机制，它会在引用判断是否需要释放对象，对性能的影响固定。
不可变类型可以在多份引用中只使用一个实例，减少了内存的开销，也减少直接只用指针容易的闪失。
不过对于循环引用，即几个废弃的对象引用呈环状关系，引用计数将失去它的效果，这是这种机制的欠缺。
目前一些动态类型的脚本语言所用的垃圾收集常基于引用计数机制并加入了不计算计数的弱引用或者是对循环引用的检测的机制。

接下来说mark-sweep标记清除，这种方法是为每个对象设置一个标记位，把所用需要内存管理的对象加入列表中。
在垃圾回收的时候，先全部标记位清除，然后从一个对象的引用开始，给所有从它开始能访问到的对象设置标记。
最后没有被标记的对象已经无法再使用了，它们被当作垃圾处理，析构并释放内存，至此垃圾回收过程完毕。
示例代码如下：
#include <iostream>
#include <vector>
#include <list>
#include <algorithm>
using namespace std;
struct MM {
class Entry {
private:
 Entry(Entry&);
 Entry& operator =(Entry&);
public:
 bool mark;
 vector<Entry*> related;
 vector<Entry*>& getRelated(){
 return related;
 }
 Entry() :
 mark(false) {
 }
 virtual ~Entry() {
 }
};
list<Entry*> allEnt;
template<class T>
class TypedEntry: public Entry {
private:
 TypedEntry(TypedEntry&) {
 }
 TypedEntry& operator =(TypedEntry&) {
 }
public:
 T* pointer;
 TypedEntry(T* object) :
 pointer(object) {
 }
 T* operator->() {
 return this->pointer;
 }
 virtual ~TypedEntry() {
 delete pointer;
 }
};
template<class T>
TypedEntry<T>* manage(T* object) {
 TypedEntry<T>* self = new TypedEntry<T> (object);
 allEnt.push_front((Entry*) self);
 return self;
}
Entry* root;
void setRoot(Entry* rootEntry){
 root=rootEntry;
}
static bool not_marked(Entry& it) {
 return !it.mark;
}
static void mark_it(Entry* it) {
 it->mark = true;
 mark_related(it->related);
}
static void mark_related(vector<Entry*> it) {
 for_each(it.begin(), it.end(), mark_it);
}
void mark() {
 mark_it(root);
}
void sweep() {
 list<Entry*> new_all;
 for (list<Entry*>::iterator it = allEnt.begin(); it
 != allEnt.end(); ++it) {
 if (not_marked(**it)) {
 delete *it;
 } else {
 new_all.push_front(*it);
 }
 }
 allEnt= new_all;
}
void clear() {
 for (list<Entry*>::iterator it = allEnt.begin(); it
 != allEnt.end(); ++it) {
 (*it)->mark = false;
 }
}
 void gc() {
 clear();
 mark();
 sweep();
 }
};
class O {
 int num;
public:
 O(int n):num(n){}
 void print() {
 cout << "#print O" <<num<<endl;
 }
 ~O(){
 cout<<"free O"<<num<<endl;
 }
};
MM Global;
int main() {
 MM::TypedEntry<O>* r1 = Global.manage(new O(1));
 MM::TypedEntry<O>* r2 = Global.manage(new O(2));
 MM::TypedEntry<O>* r3 = Global.manage(new O(3));
 MM::TypedEntry<O>* r4 = Global.manage(new O(4));
 (*r2)->print();
 r2->getRelated().push_back(r3);
 r1->getRelated().push_back(r4);
 Global.setRoot(r1);
 Global.gc();
 (*r1)->print();
 //(*r3)->print(); //error!
 return 0;
}
执行显示：
#print O2
free O3
free O2
#print O1
如果gc之后依然使用r3的话，将会有异常的执行结果（C++不会像Java一样有默认的边界检测）。
相比于引用计数，标记清除对付循环引用没有一点问题，所以更具通用性。
不过要注意的是在gc的时候，整个程序会暂时停止执行，直到gc过程完毕，如果在交互中用户感到停顿会觉得不友好。
上面的过程中gc是手动调用的，而实际的场合可根据内存的消耗情况自动调用，当程序简单时可能到结束时才释放内存。
标记清除的方式，仅仅是释放废弃的对象，适用于对象平均体积较大且存在时间较长的情况。
对于不可变对象，从节省内存的角度说，有多个指向某一对象引用是不影响标记清除的过程的。
在Scheme中字符串是可变的，是字符组成的向量，而Java中的字符串是不可变的，自动管理的内存片段。
而且虽然有点像，Java的Finalize和C++的析构是不同的东西，析构函数是能保证一定会被调用的。
原理上说是这样，不过标记方法具体的实现方式对于整个垃圾回收在实例场合下的性能和内存占用是很重要的（比如内存紧张的情况，以及时间有限制的情况）。

下面要说的是copy-sweep复制清除，其原理是把内存分为两部分，把上面mark过程换为copy，原本的内存全部清除。
这样做的好处是在gc的时候，同时减少了内存的碎片，适用于内存对象生存时间较短（如局部变量）的情况。
需要注意的是copy过程之后，对象所引用的其他对象的地址都需要改变，这需要在gc过程保存新旧地址的对应关系。
由于用enum+unico组成的struct是大小固定的，每次分配时可预留下多个组成free_list，构成一组内存Pool，也减少了释放时的碎片。
这段需要实现自己的malloc过程，演示用代码坑。

为了优化垃圾收集的效率，减少垃圾收集对性能的影响，可以：
Generational世代收集对不同用途的对象使用不同的垃圾收集算法，
Incremental增量收集，将整个垃圾收集过程分解为时间较短的过程，
Concurrent并行收集，程序运行和垃圾收集过程同时进行。
关于这些垃圾收集的具体的信息可以查阅相关的资料，这里仅仅是在涉及最基本的情况。

* Scheme Toy #35 impl.

这篇当时根本就没写，看来这篇要安排到第三期的内容。不过下次不叫第三期了，而会使用一个给别人看起来更加明了的标题。
不然的话，已写出的内容太像笔记了。都是多把自己当唯一读者写出来的东西了，明明很随意，还扮演的很镇定。

关于Scheme的实现的话，模式已经比较固定了。
首先是实现那几个数据类型，以及把字符串解析为所定义的类型表示的形式。
除非是用Scheme自己来实现自己，这步算是开头，虽然不见得必须。
如果要写解释器的话，就可以直接写了。写编译器的话，就要朝着中间代码。
然后又有两个途径，写中间代码的解释器，或者写生成目标代码的生成器。
其中CPS是中间代码的一个等价变化，会影响到内存管理的情况。
说到内存管理，不要忘记垃圾收集，这里之前的编目在这方面说的太简单了。

暂且，就这样了。

Z's Yard[中文]

2011年5月28日星期六

日记帖

2011年5月22日星期日

[二]Scheme Toy - 进阶篇

我的简介

博客归档