(* Benchmark for union-find implementations *)

open Format

module Time = struct
  open Unix
    
  let utime f x =                                                   
    let u = (times()).tms_utime in                                  
    let y = f x in
    let ut = (times()).tms_utime -. u in
    (y,ut)
      
  let print_utime f x = 
    let (y,ut) = utime f x in
    Printf.printf "user time: %2.2f\n" ut;
    y

end

module MakeBench(UF : Sig.UnionFind) = struct

  (* sanity checks *)

  let t = UF.create 10
  let () = assert (UF.find t 0 <> UF.find t 1)
  let t = UF.union t 0 1
  let () = assert (UF.find t 0 = UF.find t 1)
  let () = assert (UF.find t 0 <> UF.find t 2)
  let t = UF.union t 2 3 
  let t = UF.union t 0 3
  let () = assert (UF.find t 1 = UF.find t 2)
  let t = UF.union t 4 4
  let () = assert (UF.find t 4 <> UF.find t 3)

  let fold_int i j f acc =
    let rec loop acc k = if k > j then acc else loop (f acc k) (k+1) in
    loop acc i

  let _ = 
    fold_int 0 99
      (fun t i ->
	 let t = UF.union t 0 i in
	 assert (UF.find t 0 = UF.find t i);
	 if i < 99 then assert (UF.find t 0 <> UF.find t (i+1));
	 t)
      (UF.create 100)

  let () =
    let t = 
      fold_int 0 49 (fun t i -> UF.union t i (99-i)) (UF.create 100)
    in
    let t =
      fold_int 0 49 (fun t i -> UF.union t i (i+1)) t 
    in
    for j = 0 to 99 do assert (UF.find t 0 = UF.find t j) done

  (* bench *)

  let () = Random.init 123

  let bench n t = 
    fold_int 0 9
      (fun t k ->
	 let range = n / (10 - k) in
	 let t = 
	   fold_int 1 (range / 2) 
	     (fun t _ -> 
		let i = Random.int range in
		let j = Random.int range in
		UF.union t i j)
	     t
	 in
	 fold_int 1 n
	   (fun t _ ->
	      let i = Random.int range in
	      let _ = UF.find t i in
	      t)
	   t)
      t

  let bencht n  =
    printf "%d: @?" n;
    let (_,tm) = Time.utime (bench n) (UF.create n) in
    printf "%5.2f@? " tm

  (* backtrack bench *)

  let height = 4

  let bbench pu n =
    let rec descend h k t = 
      if k < n then (* find or union *)
	if Random.float 1.0 < pu then (* union *)
	  let i = Random.int n in
	  let j = Random.int n in
	  let t = UF.union t i j in
	  descend h (k+1) t
	else
	  let i = Random.int n in
	  let _ = UF.find t i in
	  descend h (k+1) t
      else if h < height then begin (* branch *)
	descend (h+1) 0 t;
	descend (h+1) 0 t
      end
	(* done *)
    in
    descend 0 0

  let bbencht pu n  =
    printf "%2d%% %d: @?" (truncate (100. *. pu)) n;
    let (_,tm) = Time.utime (bbench pu n) (UF.create n) in
    printf "%5.2f@? |" tm

  let () =
    bbencht 0.05  20000;
    bbencht 0.05 100000;
    bbencht 0.05 500000;
    bbencht 0.10  20000;
    bbencht 0.10 100000;
    bbencht 0.10 500000;
    bbencht 0.15  20000;
    bbencht 0.15 100000;
    bbencht 0.15 500000

  let () = printf "@."

end

let () = printf "Tarjan : @?"
module BenchTarjan = MakeBench(Tarjan)

let () = printf "Pt(Pa2): @?"
module BenchPuf8 = MakeBench(Ptarjan.Make(Pa2))

(**
let () = printf "Ppt(Pa): @?"
module BenchPuf8a = MakeBench(Pptarjan.Make(Pa))
**)

let () = printf "Pt(Pa3): @?"
module BenchPuf10 = MakeBench(Ptarjan.Make(Pa3))

let () = printf "Pt(Pa4): @?"
module BenchPuf10a = MakeBench(Ptarjan.Make(Pa4))

let () = printf "defun  : @?"
module BenchPuf9 = MakeBench(Pt1)

let () = printf "Puf1   : @?"
module BenchPuf1 = MakeBench(Puf1)

let () = printf "Puf3   : @?"
module BenchPuf3 = MakeBench(Puf3)

let () = printf "Pt(Map): @?"
module M = struct 
  module IntM = Map.Make(struct type t = int let compare = compare end)
  open IntM
  let rec foldij f i j acc = 
    if i > j then acc else foldij f (i+1) j (f i acc)
  type t = int IntM.t
  let create n v = foldij (fun i m -> add i v m) 0 (n-1) empty
  let init n f = foldij (fun i m -> add i (f i) m) 0 (n-1) empty
  let get m i = find i m
  let set m i v = add i v m
end
module BenchPtMap = MakeBench(Ptarjan.Make(M))

(*
let () = printf "Pt(Pa1): @?"
module BenchPuf7 = MakeBench(Ptarjan.Make(Pa1))

let () = printf "Puf6   : @?"
module BenchPuf6 = MakeBench(Puf6)
*)