相互递归(3)
版权申明：本文为博主窗户(Colin Cai)原创，欢迎转帖。如要转贴，必须注明原文网址
http://www.cnblogs.com/Colin-Cai/p/10963080.html
作者：窗户
QQ/微信：6679072
E-mail：6679072@qq.com我们根据上一章最开始的相互递归转一般递归的方法，结合Y Combinator，来对第一章的append实现做一下测试。
(define (append . lst)
(if (null? lst)
'()
((apply _append (cdr lst)) (car lst))
)
)
(define (_append . lst)
(cond
((null? lst) (lambda (x) x))
((null? (cdr lst))
(lambda (x)
(if (null? x)
(car lst)
(cons (car x) ((_append (car lst)) (cdr x)))
)
)
)
(else (_append (apply append lst)))
)
)上述实现中，append和_append互相递归。
按照第二章中相互递归转普通递归的方法，我们可以定义一个高阶函数append-high，
使得(append-high 1)就是append，(append-high 2)就是_append。
于是我们可以这样写，append-high带一个参数，如果参数为1，则是上述append的定义，否则则为上述_append的定义，并在定义中把append和_append都用append-high表示。代码如下：
(define (append-high n)
(if (= n 1)
(lambda lst
(if (null? lst)
'()
((apply (append-high 2)(cdr lst)) (car lst))))
(lambda lst
(if (null? lst)
(lambda (x) x)
(if (null? (cdr lst))
(lambda (x)
(if (null? x)
(car lst)
(cons (car x) (((append-high 2)(car lst)) (cdr x)))))
((append-high 2) (apply (append-high 1) lst)))))))完全写成lambda的方式(实际上，define (funname arg)这样的写法是语法糖)，以便于后面全用lambda演算。
代码如下：
(define append-high
(lambda (n)
(if (= n 1)
(lambda lst
(if (null? lst)
'()
((apply (append-high 2)(cdr lst)) (car lst))))
(lambda lst
(if (null? lst)
(lambda (x) x)
(if (null? (cdr lst))
(lambda (x)
(if (null? x)
(car lst)
(cons (car x) (((append-high 2)(car lst)) (cdr x)))))
((append-high 2) (apply (append-high 1) lst))))))))以append-high为不动点的函数则为以下:
(define fix-append-high
(lambda (append-high)
(lambda (n)
(if (null? n)
(lambda lst
(if (null? lst)
'()
((apply (append-high '(()))(cdr lst)) (car lst))))
(lambda lst
(if (null? lst)
(lambda (x) x)
(if (null? (cdr lst))
(lambda (x)
(if (null? x)
(car lst)
(cons (car x) (((append-high '(()))(car lst)) (cdr x)))))
((append-high '(())) (apply (append-high '()) lst)))))))))于是这个函数前面接上Y Combinator就得到了append-high函数，再加上参数1，就是我们最终要实现的append函数。
一起写了，如下：
(define append
(
((lambda (f)
((lambda (g) (g g))(lambda (x) (f (lambda s (apply (x x) s))))))
(lambda (append-high)
(lambda (n)
(if (null? n)
(lambda lst
(if (null? lst)
'()
((apply (append-high 2)(cdr lst)) (car lst))))
(lambda lst
(if (null? lst)
(lambda (x) x)
(if (null? (cdr lst))
(lambda (x)
(if (null? x)
(car lst)
(cons (car x) (((append-high 2)(car lst)) (cdr x)))))
((append-high 2) (apply (append-high 1) lst)))))))))
1)
)于是，到这里，我们完全用lambda演算写出来的append就这么实现了，虽然看上去的确不是那么好懂，lambda漫天飞。
实现看上去这么抽象的函数真的好用吗？测试一下，看看结果对不对？
(append '() '(1) '(2 3) '() '(4 5 6) '(7) '(8) '(9 10 11))
得到结果
(1 2 3 4 5 6 7 8 9 10 11)
上述结果说明，函数实现的还是可以用的。
第一章最后给出的三个函数互相递归，我们也还是验证一下。
(define (type0? x)
(if (= x 0)
#t
(type2? (- x 1))
)
)
(define (type1? x)
(if (= x 0)
#f
(type0? (- x 1))
)
)
(define (type2? x)
(if (= x 0)
#f
(type1? (- x 1))
)
)建立一个高阶函数type-high，让(type-high 0)就是type0?，(type-high 1)就是type1?，(type-high 2)就是type2?
注意，所有都用lambda来表示。
(define type-high
(lambda (n)
(cond
((= n 0) (lambda (x) (if (= x 0) #t ((type-high 2) (- x 1)))))
((= n 1) (lambda (x) (if (= x 0) #f ((type-high 0) (- x 1)))))
(else (lambda (x) (if (= x 0) #f ((type-high 1) (- x 1)))))
)
)
)type-high使用Y Combinator匿名递归，实现则为如下
(define type-high
(
(lambda (f)
((lambda (g) (g g))(lambda (x) (f (lambda s (apply (x x) s)))))
)
(lambda (f)
(lambda (n)
(cond
((= n 0) (lambda (x) (if (= x 0) #t ((f 2) (- x 1)))))
((= n 1) (lambda (x) (if (= x 0) #f ((f 0) (- x 1)))))
(else (lambda (x) (if (= x 0) #f ((f 1) (- x 1)))))
)
)
)
)
)之前的type0? type1? type2?分别是(type-high 0)、(type-high 1)、(type-high 2)
于是我们可以用以下来验证
(for-each
(lambda (x) (display x)(newline))
(map
(lambda (x)
(cons
x
(map (lambda (f) (f x)) (map (lambda (n) (type-high n)) '(0 1 2)))
)
)
(range 20)
)
)验证结果没有问题
(0 #t #f #f) (1 #f #t #f) (2 #f #f #t) (3 #t #f #f) (4 #f #t #f) (5 #f #f #t) (6 #t #f #f) (7 #f #t #f) (8 #f #f #t) (9 #t #f #f) (10 #f #t #f) (11 #f #f #t) (12 #t #f #f) (13 #f #t #f) (14 #f #f #t) (15 #t #f #f) (16 #f #t #f) (17 #f #f #t) (18 #t #f #f) (19 #f #t #f)