斐波那契数列

fib.scm

(define (vector+vector a b)
  (define (vector+vector-iter a b value)
    (if (null? a) (reverse value)
      (vector+vector-iter (cdr a) (cdr b) (cons (+ (car a) (car b)) value)  )))
  (vector+vector-iter a b '()))

(display "vector+vector: ")
(display (vector+vector '(1 2 3) '(4 5 6)))
(display "\n")


(define (vector*number v n)
  (define (vector*number-iter v n value)
    (if (null? v) (reverse value)
      (vector*number-iter (cdr v) n (cons (* n (car v)) value))))
  (vector*number-iter v n '()))

(display "vector*number: ")
(display (vector*number '(1 2 3) 2))
(display "\n")


(define (get-zero-vector v)
  (define (get-zero-vector-iter v value)
    (if (null? v) value
      (get-zero-vector-iter (cdr v) (cons 0 value))))
  (get-zero-vector-iter v '()))

(display "get-zero-vector: ")
(display (get-zero-vector '(1 2 3)))
(display "\n")

(define (get-identity-vector len position)
  (define (get-identity-vector-iter len position current value)
    (cond
      ((> current len) (reverse value))
      ((= position current) (get-identity-vector-iter len position (+ 1 current) (cons 1 value)))
      (else
        (get-identity-vector-iter len position (+ 1 current) (cons 0 value)))))
  (get-identity-vector-iter len position 1 '()))

(display "get-identity-vector: ")
(display (get-identity-vector 3 3))
(display "\n")

(define (get-identity-matrix n)
  (define (get-identity-matrix-iter len current value)
    (if (> current len) (reverse value)
      (get-identity-matrix-iter len (+ 1 current) (cons (get-identity-vector len current) value))))
  (get-identity-matrix-iter n 1 '()))

(display "get-identity-matrix ")
(display (get-identity-matrix 3))
(display "\n")


(define (matrix*vector m v)
  (define (matrix*vector-iter m v value)
    (if (null? v) value
      (matrix*vector-iter (cdr m) (cdr v) (vector+vector value (vector*number (car m) (car v))))))
  (matrix*vector-iter m v (get-zero-vector (car m))))

(display "matrix*vector: ")
(display (matrix*vector '((1 2) (3 4) (5 6)) '(1 2 3)))
(display "\n")


(define (matrix*matrix a b)
  (define (matrix*matrix-iter a b value)
    (if (null? b) (reverse value)
      (matrix*matrix-iter a (cdr b) (cons (matrix*vector a (car b)) value) ))) 
  (matrix*matrix-iter a b '()))

(display "matrix*matrix ")
(display (matrix*matrix '((1 1) (1 0)) '((2 3) (5 2))))
(display "\n")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define T '((1 1) (1 0)))
(define (fib n)
  (define (fib-iter current target t)
    (if (= current target) (car (car t))
      (if (< (* 2 current) target) (fib-iter (* 2 current) target (matrix*matrix t t))
        (fib-iter (+ 1 current) target (matrix*matrix t T)))))
  (cond
    ((= n 0) 0)
    ((= n 1) 1)
    (else
      (fib-iter 1 (- n 1) T)))
)


(define (fib-fix n)
  (define (fib-iter base target current)
    (cond
      ((= target 0) (car (car current)))
      ((odd? target) (fib-iter base (- target 1) (matrix*matrix current base)))
      (else
        (fib-iter (matrix*matrix base base) (/ target 2) current))))
  (cond
    ((= n 0) 0)
    ((= n 1) 1)
    (else
      (fib-iter T (- n 1) (get-identity-matrix 2) )))
)


(define (fib-simple n)
  (define (fib-iter current target a11 a21 a12 a22)
    (if (= current target) a11
      (if (< (* 2 current) target) (fib-iter (* 2 current) target
                                             (+ (* a11 a11) (* a12 a21) )
                                             (+ (* a21 a11) (* a22 a21) )
                                             (+ (* a11 a12) (* a12 a22) )
                                             (+ (* a21 a12) (* a22 a22) )
                                             )
        (fib-iter (+ 1 current) target 
                  (+ (* a11 1) (* a12 1) )
                  (+ (* a21 1) (* a22 1) )
                  (+ (* a11 1) (* a12 0) )
                  (+ (* a21 1) (* a22 0) )
                  ))))
  (cond
    ((= n 0) 0)
    ((= n 1) 1)
    (else
      (fib-iter 1 (- n 1) 1 1 1 0)))
)

(define (fib-simple-simple n)
  (define (fib-iter current target a11 a21 a12 a22)
    (if (= current target) a11
      (if (< (* 2 current) target) (fib-iter (* 2 current) target
                                             (+ (* a11 a11) (* a12 a21) )
                                             (+ (* a21 a11) (* a22 a21) )
                                             (+ (* a11 a12) (* a12 a22) )
                                             (+ (* a21 a12) (* a22 a22) )
                                             )
        (fib-iter (+ 1 current) target 
                  (+ a11 a12 )
                  (+ a21 a22 )
                  a11
                  a21
                  ))))
  (cond
    ((= n 0) 0)
    ((= n 1) 1)
    (else
      (fib-iter 1 (- n 1) 1 1 1 0)))
)



(define (normal-fib n)
  (define (fib-iter current target n n-1 n-2)
    (if (= current target) n
      (fib-iter (+ 1 current) target (+ n n-1) n n-1)))
  (fib-iter 2 n 1 1 0))


(define (fib-book n)
  (define (fib-iter a b p q count)
    (cond ((= count 0) b)
          ((even? count)
           (fib-iter a
                     b
                     (+ (* p p) (* q q)) ; compute p′
                     (+ (* 2 p q) (* q q)) ; compute q′
                     (/ count 2)))
          (else (fib-iter (+ (* b q) (* a q) (* a p))
                          (+ (* b p) (* a q))
                          p
                          q
                          (- count 1)))))
  (fib-iter 1 0 0 1 n))



(use-modules (statprof))
(statprof-start)
;(normal-fib 1000000)
;(fib 1000000)
;(fib-simple 1000000)
;(fib-simple-simple 1000000)
;(fib-book 1000000)

(fib-fix 10000000)

(statprof-stop)
(statprof-display)