相互回归(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 (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)