; Fibonacci - generates the nth Fibonacci number in O(log n) time.
;
; Functions:
;   (fibonacci n)    Return the nth Fibonacci number.
;   (fibonacci i j)  Return the Fibonacci series from i to j.
;
; Author:
;   Jules Milner-Brage
;   jules(at)milner-brage.com
;
;   Jeff Walker
;   jwalker(at)cs.oberlin.edu
;
; Version:
;   02.27.2001  jwalker
;      Changed: Support for -Fibonacci numbers by inverting the matrix
;                   Much faster series, was approx. O((j-i)log i) now O(j-i+log i)
;   02.26.2001   jules
;

(require-library "math.ss") ; for the square function


(define fibonacci
  (lambda p
    (letrec ((number
              (lambda (n)
                (vector-ref (matrix n) 1)))
             (series
              (lambda (i j)
                (letrec ((n (matrix j))
                         (start (list (vector-ref n 0) (vector-ref n 1))))
                  (if (= i j)
                      (cdr start)
                      (fib-seq start (- j i 2))))))
             (fib-seq
               (lambda (lst n)
                 (if (> n 0)
                     (fib-seq (cons (- (cadr lst) (car lst)) lst) (- n 1))
                     lst)))
             (matrix
              (lambda (n)
                (cond ((= n 0) (vector 1 0 1))
                      ((= n 1) (vector 0 1 1))
                      ((< n 0) (invert (matrix (- n))))
                      ((odd? n) (multiply (vector 0 1 1)
                                          (multiply (matrix (/ (- n 1) 2))
                                                    (matrix (/ (- n 1) 2)))))
                      (else (multiply (matrix (/ n 2))
                                      (matrix (/ n 2)))))))
             (multiply
              (lambda (a b)
                (vector (+ (* (vector-ref a 0) (vector-ref b 0))
                           (* (vector-ref a 1) (vector-ref b 1)))
                        (+ (* (vector-ref a 0) (vector-ref b 1))
                           (* (vector-ref a 1) (vector-ref b 2)))
                        (+ (* (vector-ref a 1) (vector-ref b 1))
                           (* (vector-ref a 2) (vector-ref b 2))))))
             (invert
              (lambda (m)
                (let ((det (- (* (vector-ref m 0) (vector-ref m 2))
                              (square (vector-ref m 1)))))
                  (vector (/ (vector-ref m 2) det)
                          (- (/ (vector-ref m 1) det))
                          (/ (vector-ref m 0) det))))))
      (cond ((null? p) (error 'too-few-arguments
                              "Pass either one or two!"))
            ((null? (cdr p)) (number (car p)))
            ((< (cadr p) (car p)) (error 'invalid-range
                                         "Pass argument two > argument one!"))
            ((null? (cddr p)) (series (car p) (cadr p)))
            (else (error 'too-many-arguments
                         "Pass either one or two!"))))))