aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

21
Task/Fibonacci-sequence/Common-Lisp/fibonacci-sequence-7.lisp Normal file
View file

@ -0,0 +1,21 @@
(defconstant +2x2-identity+ '(1 0 0 1))
(defconstant +fib-seed+ '(1 1 1 0))
(defun multiply-2x2 (matrix-1 matrix-2)
(let* ((a (first matrix-1)) (b (second matrix-1)) (c (third matrix-1)) (d (fourth matrix-1))
(e (first matrix-2)) (f (second matrix-2)) (g (third matrix-2)) (h (fourth matrix-2))
(ae (* a e)) (bg (* b g)) (af (* a f)) (bh (* b h))
(ce (* c e)) (dg (* d g)) (cf (* c f)) (dh (* d h)))
(list (+ ae bg) (+ af bh) (+ ce dg) (+ cf dh))))
(defun square-2x2 (matrix)
(multiply-2x2 matrix matrix))
(defun 2x2-exponentiation (matrix n)
(cond ((zerop n) +2x2-identity+)
((eql n 1) matrix)
((evenp n) (square-2x2 (2x2-exponentiation matrix (/ n 2))))
(t (multiply-2x2 (square-2x2 (2x2-exponentiation matrix (/ (1- n) 2))) matrix))))
(defun fib (n)
(car (2x2-exponentiation +fib-seed+ (1- n))))