Scheme 언어로 30000! 계산하기

프로그래밍/Scheme 2013. 2. 9. 23:42

* 소스 파일명: rec-fact.scm

;;; Filename: rec-fact.scm
;;;
;;;         (fact n) : factorial function
;;;         (fibo n) : fibonacci function
;;;         (fib n) : nice fibonacci function
;;;
;;;      Date: 2013. 2.10.
;;;    Author: pkim ((AT)) scripts ((DOT)) pe ((DOT)) kr

#|
;; An usual recursive factorial function.
;; This is slow and gives rise a stack overflow.
(define fact
(lambda (n)
    (let loop (i k)
        (if (<= i 1) k
        (else (loop (- i 1) (* k (- k 1)) )) )
)
loop (n n))
|#

;; Not recursive, but this call the internally defined tail-recursive function.
(define (fact n)
    ;; A tail recursive factorial function
    ;; The value which will be returned, is accumulated
    ;; at the parameter acc while looping
    (define (fact-aux n acc)
        (if (zero? n)
            acc
            (fact-aux (- n 1) (* acc n) )))
    (fact-aux n 1))

;; Not recursive, but this call the internally defined tail-recursive function.
(define (fibo n)
    ;; A tail recursive factorial function
    ;; The value which will be returned, is accumulated
    ;; at the parameter acc2 while looping
    (define (fibo-aux n acc1 acc2)
        (if (<= n 1)
            acc2
            (fibo-aux (- n 1) acc2 (+ acc1 acc2) )))
    (fibo-aux n 0 1))

;;; (fib n) Fast fibonacci function
;;;
;;; Written by Edsger W. Dijkstra
;;;
;;; See: http://en.literateprograms.org/Fibonacci_numbers_(Scheme)

(define (fib n)
(define (fib-aux a b p q count)
    (cond ((= count 0) b)
          ((even? count)
           (fib-aux a
                    b
                    (+ (* p p) (* q q))
                    (+ (* q q) (* 2 p q))
                    (/ count 2)))
          (else
           (fib-aux (+ (* b q) (* a q) (* a p))
                    (+ (* b p) (* a q))
                    p
                    q
                    (- count 1)))))
(fib-aux 1 0 0 1 n))

* Cygwin 의 CHICKEN Scheme 대화형 인터프리터 csi 실행

$ csi rec-fact.scm

CHICKEN
(c)2008 The Chicken Team
(c)2000-2007 Felix L. Winkelmann
Version 3.4.0 - windows-cygwin-x86 [ manyargs dload ptables applyhook ]
SVN rev. 11987 compiled 2008-10-09 on NTXCN1042727 (CYGWIN_NT-5.1)

; loading rec-fact.scm ...
#;1> (fact 10)
3628800
#;2> (fact 100)
9.33262154439442e+157
#;3> (fib 10)
55
#;4> (fib 100)
3.54224848179262e+20
#;5> (fibo 10)
55
#;6> (fibo 100)
3.54224848179262e+20