版权申明:本文为博主窗户(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)

版权声明:本文为Colin-Cai原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://www.cnblogs.com/Colin-Cai/p/10963080.html