serious stuff
www.cubbi.com
personal
programming
fibonacci numbers
forth examples
postscript examples
muf examples
joy examples
j examples
scheme examples
hope examples
ocaml examples
haskell examples
prolog examples
c++ examples
java examples
assembly language examples
fortran examples
c examples
sh examples
awk examples
perl examples
tcl examples
asmix
hacker test
resume
science
martial arts
fun stuff
www.cubbi.org

OCaml
Date: 1989
Type: Impure functional, objectoriented, strictly typed.
Usage: Various applications, such as FFTW library (the ubiquitous fast fourier transform library), mldonkey (the most popular p2p file sharing client), coq (the proof assistant), some financial and industrial applications.
This language was a very good attempt at making a practical functional language, as opposed to academic research one. It includes a highly optimized native code compiler (on par with C, according to the Shootout) and bindings to OpenGL, GTK, Win32 API, LAPACK, and other C/C++/Fortran libraries.
ALGORITHM 1A: NAIVE BINARY RECURSION 
let rec fib = function
 0 > 0
 1 > 1
 n > fib (n1) + fib (n2)
let f n =
(if n<0 && n mod 2=0 then fun n > n else fun n > n)
(fib (abs n))
let _ =
let n =
try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f1a <n>" in
let answer = f n in
Printf.printf "%dth Fibonacci number is %d\n" n answer

ALGORITHM 1B: CACHED BINARY RECURSION 
open Num
let fib n =
let an = abs n in
let cache = Array.make (an+1) (Int 0) in
let rec f = function
 0 > Int 0
 1 > Int 1
 n > if cache.(n) =/ Int 0
then cache.(n) < f (n1) +/ f (n2);
cache.(n) in
(if n<0 && n mod 2=0 then minus_num else fun n > n)
(f an)
let _ =
let n =
try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f1b <n>" in
let answer = fib n in
Printf.printf "%dth Fibonacci number is %s\n" n (string_of_num answer)

ALGORITHM 2A: CACHED LINEAR RECURSION / INFINITE LAZY EVALUATED LIST 
open Num
open Lazy
type 'a inf_list = Cons of 'a * 'a inf_list lazy_t
let tl l = match l with Cons (_, t) > force t
let rec map2 f l l' =
match l, l' with
Cons (h, t), Cons (h', t')
> Cons (f h h', lazy (map2 f (force t) (force t')))
let rec nth lst n = match (lst, n) with
 (_, n) when n < 0 > invalid_arg "negative index in nth"
 (Cons(x, _), 0) > x
 (Cons(_, t), n) > nth (force t) (n  1)
let rec fibs = Cons (Int 0, lazy
(Cons (Int 1, lazy
(map2 ( +/ ) fibs (tl fibs)))))
let _ =
let n =
try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f2a <n>" in
let answer =
(if n<0 && n mod 2=0 then minus_num else fun n > n)
(nth fibs (abs n)) in
Printf.printf "%dth Fibonacci number is %s\n" n (string_of_num answer);

ALGORITHM 2B: LINEAR RECURSION WITH ACCUMULATOR 
open Num
let rec fib ?(a=Int 0) ?(b=Int 1) n = match n with
 0 > a
 1 > b
 n > fib ~a:b ~b:(a +/ b) (n1)
let f n =
(if n<0 && n mod 2=0 then minus_num else fun n > n)
(fib (abs n))
let _ =
let n = try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f2b <n>" in
let answer = f n in
Printf.printf "%dth Fibonacci number is %s\n" n (string_of_num answer)

ALGORITHM 2C: IMPERATIVE LOOP WITH VARIABLES 
open Num
let f n =
let tmp = ref (Int 0) in
let x1 = ref (Int 0) in
let x2 = ref (Int 1) in
for i = 1 to abs n do
tmp := !x1 +/ !x2;
x1 := !x2;
x2 := !tmp;
done;
if n < 0 && (n mod 2) = 0 then minus_num !x1 else !x1
let _ =
let n = try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f2c <n>" in
let answer = f n in
Printf.printf "%dth Fibonacci number is %s\n" n (string_of_num answer)

ALGORITHM 3A: MATRIX MULTIPLICATION 
open Num
open List
let inner base f l1 l2 g =
fold_left2 (fun accu e1 e2 > g accu (f e1 e2)) base l1 l2
let dot a b =
inner (Int 0) ( */ ) a b ( +/ )
let rec transpose m =
if mem [] m then []
else map hd m :: transpose (map tl m)
let matmult ml mr =
let m2 = transpose mr in
map (fun row > map (fun col > dot row col) m2) ml
let rec fast_power fmul one x n = match n with
 n when n < 0 > invalid_arg "fast_power requires nonnegative n"
 0 > one
 n > let sq = fmul x x in
if n mod 2=1 then fast_power fmul (fmul one x) sq (n/2)
else fast_power fmul one sq (n/2)
let rec f = function
 0 > Int 0
 n > let m = [[Int 1; Int 1;];
[Int 1; Int 0 ]] in
let one = [[Int 1; Int 0;];
[Int 0; Int 1 ]] in
(if n<0 && n mod 2=0 then minus_num else fun n > n)
(hd (hd (fast_power matmult one m ((abs n)1))))
let _ =
let n = try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f3a <n>" in
let answer = f n in
Printf.printf "%dth Fibonacci number is %s\n" n (string_of_num answer)

ALGORITHM 3B: FAST RECURSION 
open Num
let rec f = function
 n when n<0 > invalid_arg "negative argument"
 0 > (Int 0, Int 0)
 1 > (Int 1, Int 0)
 n > let (k2, k1) = f (n/2) in
let k3 = k2 +/ k1 in
let k2s = k2 */ k2 in
let k1s = k1 */ k1 in
let k3s = k3 */ k3 in
if (n mod 2) = 0 then (k1+/k3)*/k2, k1s+/k2s
else k3s+/k2s, (k1+/k3)*/k2
let _ =
let n = try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f3b <n>" in
let answer =
(if n<0 && n mod 2=0 then minus_num else fun n > n)
(fst (f (abs n))) in
Printf.printf "%dth Fibonacci number is %s\n" n (string_of_num answer)

ALGORITHM 3C: BINET'S FORMULA WITH ROUNDING 
open Gmp
let ( +. ), ( *. ), ( . ) = F.add, F.mul, F.sub
let invsqrt a =
let start = F.from_float (1. /. sqrt a ) in
let f x = F.from_float 0.5 *. x *. (F.from_float 3. . F.from_float a *. x *. x) in
let rec loop f x =
let x' = f x in
if F.eq x x' !F.default_prec then x
else loop f x'
in
loop f start
let rec fast_power fmul one x n = match n with
 n when n < 0 > invalid_arg "fast_power requires nonnegative n"
 0 > one
 n > let sq = fmul x x in
if n mod 2=1 then fast_power fmul (fmul one x) sq (n/2)
else fast_power fmul one sq (n/2)
let fib n =
F.default_prec := 7*n/10;
let one = F.from_float 1. in
let half = F.from_float 0.5 in
let is5 = invsqrt 5. in
let s5 = F.div one is5 in
let phi = (one +. s5) *. half in
F.floor ( half +. is5 *. fast_power F.mul one phi n )
let f n =
(if n<0 && n mod 2=0 then F.neg else fun n > n)
(fib (abs n))
let _ =
let n = try int_of_string Sys.argv.(1)
with _ > invalid_arg "Usage: f3c <n>" in
let answer = F.to_string_exp_base_digits ~base:10 ~digits:n (f n) in
let answer = if n=0 then "0" else fst answer in
Printf.printf "%dth Fibonacci number is %s\n" n answer

