Commit 6d3efeb2 authored by POTTIER Francois's avatar POTTIER Francois

Add the Fib demo and its Makefile.

parent 11d58fc1
open Parentheses
open Printf
let size =
40
let generate n =
let w = Array.create n L in
let rec fill s k =
if k = 0 then
()
else begin
w.(s) <- L;
let j = 2 + 2 * ((Random.int k) / 2) in
w.(s+j-1) <- R;
fill (s+1) (j-2);
fill (s+j) (k-j)
end
in
fill 0 n;
w
module Gen =
Generator.Make(G)
let c =
Hashtbl.create 97
let tick k =
try
incr (Hashtbl.find c k)
with Not_found ->
Hashtbl.add c k (ref 1)
let bench1 () =
let word = generate size in
let answer = parse word in
tick (Array.length word);
if not answer then begin
Array.iter (function L -> print_string "(" | R -> print_string ")") word;
assert false
end
let () =
for k = 0 to 100 do
bench1 ()
done;
Hashtbl.iter (fun k c ->
printf "Tested %d words of length %d.\n" !c size
) c;
flush stdout
(* ------------------------------------------------------------------------- *)
open Maps
module F =
Fix.Make
(HashTableAsImperativeMaps(TrivialHashedType(struct type t = int end)))
(struct type property = int option let bottom = None let equal = (=) let is_maximal o = (o <> None) end)
let fib =
F.lfp (fun n fib ->
if n <= 1 then
Some 1
else
match fib (n-2), fib (n-1) with
| Some p, Some q ->
Some (p + q)
| _, _ ->
None
)
let () =
match fib 100000 with
| Some k ->
printf "fib = %d\n%!" k
| None ->
assert false;
(* TEMPORARY mettre en place plusieurs benchmarks separes, avec support Makefile *)
(* -------------------------------------------------------------------------- *)
module Int = struct
type t = int
end
(* Instantiate [Fix] for keys of type [int]
and properties of type [int option]. *)
module F =
Fix.Make
(Fix.HashTablesAsImperativeMaps(Fix.TrivialHashedType(Int)))
(Fix.Option.Make(Int))
(* -------------------------------------------------------------------------- *)
(* Using [Fix], define a memoising (therefore asymptotically efficient) version
of Fibonacci's function. *)
(* This is admittedly a degenerate use case for [Fix]. Here, the dependencies
are acyclic, so it would be preferable to use a simpler and more efficient
memoising fixed point combinator. Doing so would obviate the need for
options. Here, options are required because [Fix] requires a bottom
element, and [Fix] requires such an element because it needs one, in
general, in order to deal with cyclic dependencies. *)
let fib : int -> int option =
F.lfp (fun n fib ->
if n <= 1 then
Some 1
else
match fib (n-2), fib (n-1) with
| Some p, Some q ->
Some (p + q)
| _, _ ->
None
)
let fib : int -> int =
fun n ->
match fib n with Some k -> k | None -> assert false
(* -------------------------------------------------------------------------- *)
(* Give a direct definition of Fibonacci's function. We tabulate the function
up to a certain bound. *)
let size =
100000
let reference : int -> int =
let fib = Array.make size 1 in
for n = 2 to size - 1 do
fib.(n) <- fib.(n-2) + fib.(n-1)
done;
Array.get fib
(* -------------------------------------------------------------------------- *)
(* Check that the two versions yield equal results. *)
let () =
for i = 0 to size/2 do
assert (fib i = reference i)
done;
for i = size - 1 downto 0 do
assert (fib i = reference i)
done;
for i = 0 to size - 1 do
assert (fib i = reference i)
done;
print_endline "Success."
.PHONY: all
all:
dune build Fib.exe
.PHONY: clean
clean:
rm -f *~
dune clean
(executable
(name Fib)
(libraries fix)
(flags "-w" "A")
)
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment