[Shootout-list] fannkuch (OCaml)
ChriS
del-con@tiscali.be
Fri, 04 Mar 2005 10:54:58 +0100 (CET)
----Next_Part(Fri_Mar__4_10_54_58_2005_450)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hi,
Here is a new version (shorter and faster) of the fannkuch benchmark
for Ocaml.
ChriS
----Next_Part(Fri_Mar__4_10_54_58_2005_450)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="fannkuch.ml"
(* fannkuch.ml
ocamlopt -dtypes -o fannkuch.com -inline 3 -unsafe fannkuch.ml
*)
(* Monomorphic version for speed *)
let int_max (x : int) y = if x < y then y else x
let pfannkuchen n =
let a = Array.init n (fun i -> i)
and b = Array.make n 0 in
let rec reverse i j =
let t = b.(i) and i' = i + 1 and j' = j - 1 in
b.(i) <- b.(j); b.(j) <- t; if i' < j' then reverse i' j' in
let rec count_flips c =
let b0 = b.(0) in
if b0 = 0 then c else (reverse 0 b0; count_flips(c+1)) in
let maxc = ref 0 in
let f () =
for i = 0 to n - 1 do b.(i) <- a.(i) done;
maxc := int_max (count_flips 0) !maxc in
(* Generate the n! permutations *)
let swap i j = let t = a.(i) in a.(i) <- a.(j); a.(j) <- t in
let rec go = function
| 0 -> f()
| 1 -> f(); swap 0 1; f()
| n ->
let n' = n - 1 in
for c = 0 to n do ge n'; swap 0 n; done
and ge = function
| 0 -> f()
| 1 -> f(); swap 0 1; f()
| n ->
let n' = n - 1 in
for c = 0 to n do go n'; swap c n; done in
let n = Array.length a in
if n mod 2 = 0 then ge(n - 1) else go(n - 1);
!maxc
let () =
let n = try int_of_string Sys.argv.(1) with _ -> 1 in
Printf.printf "Pfannkuchen(%i) = %i\n" n (pfannkuchen n)
----Next_Part(Fri_Mar__4_10_54_58_2005_450)----