c(n) f x = (f ... (f x)), ただし, f は n 回出現.となることを利用します.
まず, c0 と successor を定義します. (SICP Ex.2.6 参照)
(define c0 (lambda (f) (lambda (x) x))) (define (%succ c) (lambda (f) (lambda (x) (f ((c f) x)))) )この考えは, 右図 (Lao Tsu TAO TE CHING, Vintage Book, 394-71833-X) に示した 『老子』第42節の 「道 (TAO) から一が生まれ, 一から二が生まれ, 二から三が生まれ, 三から万物が生まれ, 云々」と符合するものです.
今定義した c0 と successor から, 次々と Church numeral を定義していきます.
(define c1 (%succ c0)) (define c2 (%succ c1)) あるいは (define c2 (%succ (%succ c0))) (define c3 (%succ c2)) つまり (define c1 (lambda (f) (lambda (x) (f x)))) (define c2 (lambda (f) (lambda (x) (f (f x))))) (define c3 (lambda (f) (lambda (x) (f (f (f x))))))
(define (%add n m) (lambda (f) (lambda (x) ((m f) ((n f) x)))) ) (define (%multiply n m) (lambda (f) (lambda (x) ((n (m f)) x))) ) (define (%power n m) (lambda (f) (lambda (x) (((m n) f) x))) )
(define (c->n c) ((c (lambda (x) (+ 1 x))) 0) ) (define (n->c n) (if (> n 0) (%succ (n->c (- n 1))) c0 ))上記の c->n はメモリを大量に消費し遅いので, 下記の定義を使うべき.
(define (c->n c) ((c 1+) 0))
(c->n (%add (n->c 5) (n->c 3))) (c->n (%multiply (n->c 5) (n->c 3))) (c->n (%power (n->c 5) (n->c 3))) (c->n (%add (%power c2 c3) (%multiply c3 (n->c 4))))
(define (%true x) (lambda (y) x)) (define (%false x) (lambda (y) y)) (define (%if c x y) ((c x) y))
(define (%cons x y) (lambda (p) ((p x) y))) (define (%car x) (x %true)) (define (%cdr x) (x %false))
(define (%iszero? c) ((c (lambda (z) %false)) %true) )
(define (%gt a b) (%car ((b (lambda (z) (%if (%car z) (%cdr z) z))) ((a (lambda (z) (%cons %true z))) (%cons %false %false) ))))
(%true %true %true %true %true ... %false ・ %false)
(%gt c0 c1) (%gt c2 c1) (%gt c2 c2) (%gt (n->c 10) (n->c 8))
(define (%iszero?? c) (%if (%gt c 0) %false %true) )
(define (%predp c) ((c (lambda (z) ((z (lambda (x) x)) (%succ z)))) (lambda (a) (lambda (x) c0)) )) (define (%pred c) (%if (%gt c c0) (%predp c) c0) )
(define (%subtract n m) ((m %pred) n) )
(define (fact c) ((%if (%iszero? c) (lambda () c1) (lambda () (%multiply c (fact (%pred c)))) )))この手続きで, 正しい答が求まります. しかし, 再帰呼出しで fact という名前つきのλ式を使っています.
(define Y (lambda (f) ((lambda (x) (f (lambda (arg) ((x x) arg)))) (lambda (x) (f (lambda (arg) ((x x) arg)))) )))これにより, f で手続きを定義して, 再帰呼出しを行います. 具体的には, 次のように定義します.
(define Y-fact (Y (lambda (fact) (lambda (n) ((%if (%iszero? n) (lambda () c1) (lambda () (%multiply n (fact (%pred n)))) )))))) (c->n (Y-fact c2)) (c->n (Y-fact (n->c 10)))
(Y f) = (f (Y f))
(define (%le a b) (%iszero? (%subtract a b))) (define (%ge a b) (%le b a)) (define (%remainder divd divr) ((Y (lambda (f) (lambda (x) ((%if (%ge x divr) (lambda () (f (%subtract x divr))) (lambda () x) ))) )) divd )) (c->n (%remainder (n->c 30) c3)) (c->n (%remainder (n->c 100) (n->c 9))) (define (%divide divd divr) ((Y (lambda (f) (lambda (x) ((%if (%ge x divr) (lambda () (%succ (f (%subtract x divr)))) (lambda () c0) ))) )) divd )) (c->n (%divide (n->c 100) (n->C 9)))
2引数版の Y combinator の定義とそれを応用した %remainder2 と %divide2 を次に示します.
(define Y2 (lambda (f) ((lambda (x) (f (lambda (a b) ((x x) a b)))) (lambda (x) (f (lambda (a b) ((x x) a b))))))) (define %remainder2 (Y2 (lambda (f) (lambda (divd divr) ((%if (%ge divd divr) (lambda () (f (%subtract divd divr) divr)) (lambda () divd) )))))) (define %divide2 (Y2 (lambda (f) (lambda (divd divr) ((%if (%ge divd divr) (lambda () (%succ (f (%subtract divd divr) divr))) (lambda () c0) ))))))