相互遞歸(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)