Skip to content

Instantly share code, notes, and snippets.

@yszou
Last active Jul 28, 2019
Embed
What would you like to do?
斐波那契数列
(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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment