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

　　于是这个函数前面接上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 (= 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)))))))))
  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)