; This program calculates the nth fibonacci number
; using alrogirhtm 1A: binary recursion
;
; compiled: echo '(cf "f1a")' | mit-scheme -compiler
; executed: mit-scheme -load f1a -eval "(begin (main n) (%exit))"
; 
(declare (usual-integrations))

; the naive binary recursion: F(n) = F(n-1) + F(n-2)
(define (fib m)
  (if (< m 2)
      m
      (+ (fib (- m 1)) (fib (- m 2)))))

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
   (fib (abs n))))

; Function (main n) prints the n'th Fibonacci number
(define main (lambda (n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n))))))

; This program calculates the nth fibonacci number
; using alrogirhtm 1B: cached binary recursion
;
; compiled: echo '(cf "f1b")' | mit-scheme -compiler
; executed: mit-scheme -load f1b -eval "(begin (main n) (%exit))"
; 
(declare (usual-integrations))

; the naive binary recursion: F(n) = F(n-1) + F(n-2)
; using vector v as a cache
(define (fib m v)
  (if (positive? (vector-ref v m))
      (vector-ref v m)
      (let ((result (if (< m 2)
                      m
                      (+ (fib (- m 1) v) (fib (- m 2) v)))))
        (begin (vector-set! v m result) result))))

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
; also creates the cache vector for fib of size |n|+1
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
   (fib (abs n) (make-vector (1+ (abs n)) 0))))

; Function (main n) prints the n'th Fibonacci number
(define main (lambda (n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n))))))

; This program calculates the nth fibonacci number
; using alrogirhtm 2A: cached linear recursion (as lazy infinite list)
;
; compiled: echo '(cf "f2a")' | mit-scheme -compiler
; executed: mit-scheme -load f2a -eval "(begin (main n) (%exit))"
;
; note: full support for lazy lists was added to Scheme in SRFI-41, but I 
;       haven't had a chance to look into it yet
;
(declare (usual-integrations))
; Define the infinite lazy-evaluated list of fibonacci numbers
(define (lazy-fib-list)
  (letrec ((next-number (lambda (n m)
                        (cons n (delay (next-number m (+ n m)))))))
    (next-number 0 1)))

; functions to work with lazy lists:
; lazy car
(define lazy-head car)
; lazy cdr
(define (lazy-tail lazy-list) (force (cdr lazy-list)))
; read the nth element of the lazy list 
(define (nth n lazy-list)
  (if (<= n 0) (lazy-head lazy-list)
               (nth (- n 1) (lazy-tail lazy-list))))

; I also tried this haskell-like approach:
;
;(define (lazy-map2 f l1 l2)
;  (cons (f (lazy-head l1) (lazy-head l2))
;        (delay (lazy-map2 f (lazy-tail l1) (lazy-tail l2)))))
;
; (define (lazy-fibs)
;   (cons 0 (delay
;     (cons 1 (delay
;       (lazy-map2 + (lazy-fibs)
;                    (lazy-tail (lazy-fibs))))))))
;
; but it executed with exponential memory consumption, showing that
; it was really an equivalent of algorithm 1B

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
     (nth (abs n) (lazy-fib-list))))

; Function (main n) prints the n'th Fibonacci number
(define (main n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n)))))

; This program calculates the nth fibonacci number
; using algorithm 2B: linear recursion with accumulators
;
; compiled: echo '(cf "f2b")' | mit-scheme -compiler
; executed: mit-scheme -load f2b -eval "(begin (main n) (%exit))"
; 
(declare (usual-integrations))

; starting with a=0 and b=1, on every iteration of the recursion do:
; calculate the sum of a and b, decrement counter, recurse with 
; a instead of b and a+b instead of a. Return a if the counter is 0.
(define (fib a b c)
  (if (zero? c)
      a
      (fib (+ a b) a (-1+ c))))

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
   (fib 0 1 (abs n))))
          
; Function (main n) prints the n'th Fibonacci number
(define (main n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n)))))

; This program calculates the nth fibonacci number
; using alrogirhtm 2C: imperative loop with mutable variables
;
; compiled: echo '(cf "f2c")' | mit-scheme -compiler
; executed: mit-scheme -load f2c -eval "(begin (main n) (%exit))"
; 
(declare (usual-integrations))

; starting with x1=0 and x2=1, on every iteration of the loop do:
; calculate the sum of x1 and x2, move the contents of x2 into x1, 
; move the sum into x2, continue n times
(define (fib n)
  (do ((x1 0) (x2 1) (tmp 1) (i 1 (1+ i)))
    ((> i n) x1)
    (set! tmp (+ x1 x2))
    (set! x1 x2)
    (set! x2 tmp)))

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
   (fib (abs n))))

; Function (main n) prints the n'th Fibonacci number
(define (main n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n)))))

; This program calculates the nth fibonacci number
; using alrogirhtm 3A: matrix multiplication
;
; compiled: echo '(cf "f3a")' | mit-scheme -compiler
; executed: mit-scheme -load f3a -eval "(begin (main n) (%exit))"
; 
(declare (usual-integrations))

; Representing matrices as vectors of vectors may be faster, but to compare
; functional languages, I've decided to explore pure functional route
;
; Matrix transpose, from rosettacode.org and other sources
(define (transpose rows) (apply map (cons list rows)))
; dot product
(define (dot v1 v2) (reduce + 0 (map * v1 v2)))
; matrix multiplication
(define (mm m1 m2)
  (map (lambda (row)
         (map (lambda (col)
                (dot row col)) (transpose m2))) m1))

; generic tail-recursive exponentiation by repeated squaring
; raises object b to the nth power using multiplication function f
; and a unit object u
(define power (lambda (f u b n)
                (if (positive? n)
                  (if (even? n)
                    (power f    u    (f b b) (quotient n 2))
                    (power f (f u b) (f b b) (quotient n 2)))
                  u)))

; return zero for n=0 or raise the (1 1) (1 0) matrix to n-1 power
(define (fib n)
  (if (zero? n)
    0
    (car (car (power mm `((1 0)(0 1)) `((1 1)(1 0)) (-1+ n) )))))

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
   (fib (abs n))))
          
; Function (main n) prints the n'th Fibonacci number
(define (main n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n)))))

; This program calculates the nth fibonacci number
; using alrogirhtm 3B: fast recursion
;
; compiled: echo '(cf "f3b")' | mit-scheme -compiler
; executed: mit-scheme -load f3b -eval "(begin (main n) (%exit))"
; 
(declare (usual-integrations))

; calculate a pair of fibonacci numbers according to the recurrent relationship
; F(2n-1) = F(n-1)^2 + F(n)^2
; F(2n) = (2F(n-1) + F(n))F(n)
;
; in this procedure, k1 = F(n-1), k2 = F(n), k3 = F(n+1) 
(define (fib n)
  (case n
    ((0) (values 0 0))
    ((1) (values 1 0))
    (else (let ((m (quotient n 2)))
            (call-with-values (lambda () (fib m))
              (lambda (k2 k1)
                (let ((k3   (+ k1 k2))
                      (k1^2 (* k1 k1))
                      (k2^2 (* k2 k2))
                      (k3^2 (* (+ k1 k2) (+ k1 k2))))
                  (if (even? n)
                    (values (* (+ k1 k3) k2)
                            (+ k1^2 k2^2))
                    (values (+ k3^2 k2^2)
                            (* (+ k1 k3) k2))))))))))

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
   (car (call-with-values (lambda () (fib (abs n))) cons))))

; Function (main n) prints the n'th Fibonacci number
(define (main n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n)))))

; This program calculates the nth fibonacci number
; using alrogirhtm 3C: Binet's formula with rounding
;
; compiled: echo '(cf "f3c")' | mit-scheme -compiler
; executed: mit-scheme -load f3c -eval "(begin (main n) (%exit))"
; 
(declare (usual-integrations))

; Function fib uses Binet's formula with rounding: round(phi^n/sqrt(5))
; it has limited precision. On  my system, (fib 75) is the largest correctly
; calculated value (2111485077978050)
(define (fib n)
  (let ((phi (/ (1+ (sqrt 5)) 2)))
    (round (/ (expt phi n) (sqrt 5)))))

; negative argument handling: F(-n) = F(n)*(-1)^(n+1)
(define (f n)
  ((if (and (negative? n) (even? n)) - identity-procedure)
   (fib (abs n))))
          
; Function (main n) prints the n'th Fibonacci number
(define (main n)
 (display (string-append
              (number->string n)
              "th Fibonacci number is "
              (number->string (f n)))))