
(* Comparison functors. *)

(* open Time *)
open Printf

module type MinimalSet = sig
  type t
  val empty : t
  val mem : int -> t -> bool
  val add : int -> t -> t
  val remove : int -> t -> t
  val union : t -> t -> t
  val inter : t -> t -> t
  val diff : t -> t -> t
  val subset : t -> t -> bool
  val compare : t -> t -> int
  val fold : (int -> 'a -> 'a) -> t -> 'a -> 'a
end

module Dummy_set = struct
    type t = unit
    
    let empty = ()
    let mem _ () = true
    let add _ () = ()
    let remove _ () = ()
    let union () () = ()
    let inter () () = ()
    let diff () () = ()
    let subset () () = true
    let compare () () = 0
    let fold _ () x = x
end

module type Comparison = sig
  val check : unit -> unit
  val timings : unit -> unit
end

module BenchSet (S : MinimalSet) = struct

  include S

  let build_seq n =
    let rec build i acc =
      if i == n then acc else build (succ i) (S.add i acc)
    in
    build 0 S.empty

  let seq_10000 = build_seq 10000

  let build_rnd m n =
    Random.init 17;
    let rec build i acc =
      if i == n then acc else build (succ i) (S.add (Random.int m) acc)
    in
    build 0 S.empty

  let rnd_10000 = build_rnd 10000 10000

  let lookup_seq_seq n = 
    for i = 1 to n do let _ = S.mem (i mod 10000) seq_10000 in () done
  let lookup_rnd_seq n = 
    Random.init 17;
    for i = 1 to n do
        let _ = S.mem ((Random.int n) mod 10000) seq_10000 in ()
    done
  let lookup_seq_rnd n = 
    for i = 1 to n do let _ = S.mem (i mod 10000) rnd_10000 in () done
  let lookup_rnd_rnd n = 
    Random.init 17;
    for i = 1 to n do
        let _ = S.mem ((Random.int n) mod 10000) rnd_10000 in ()
    done

  let remove_seq_seq n = 
    let rec rm acc i = if i == n then acc else rm (S.remove i acc) (i + 1) in
    for i = 1 to 100 do ignore (rm seq_10000 0) done
  let remove_seq_rnd n = 
    let rec rm acc i = if i == n then acc else rm (S.remove i acc) (i + 1) in
    for i = 1 to 100 do ignore (rm rnd_10000 0) done
  let remove_rnd_seq n = 
    Random.init 17;
    let rec rm acc i = 
      if i == n then acc else rm (S.remove (Random.int n) acc) (i + 1) in
    for i = 1 to 100 do ignore (rm seq_10000 0) done
  let remove_rnd_rnd n = 
    Random.init 17;
    let rec rm acc i = 
      if i == n then acc else rm (S.remove (Random.int n) acc) (i + 1) in
    for i = 1 to 100 do ignore (rm rnd_10000 0) done

  let bench_op op n =
    Random.init 17;
    for i = 1 to n do 
      ignore (op (build_rnd n (Random.int i)) (build_rnd n (Random.int i))) 
    done
    
  let bench_union = bench_op S.union
  let bench_inter = bench_op S.inter
  let bench_diff = bench_op S.diff
  let bench_subset = bench_op S.subset
  let bench_compare = bench_op S.compare
end

module Dummy_bench = struct let name = "Dummy" include BenchSet(Dummy_set) end

let utime f n =
    let before = Cf_tai64n.now () in
    let x = f n in
    let after = Cf_tai64n.now () in
    let dt = Cf_tai64n.sub after before in
    x, dt

let compare_times f1 f2 f3 f4 f5 f6 n =
  Printf.printf "%8d " n; flush stdout;
  let (_,u1) = utime f1 n in
  Printf.printf "%8.2f " u1; flush stdout;
  let (_,u2) = utime f2 n in
  Printf.printf "%8.2f " u2; flush stdout;
  let (_,u3) = utime f3 n in
  Printf.printf "%8.2f " u3; flush stdout;
  let (_,u4) = utime f4 n in
  Printf.printf "%8.2f" u4; flush stdout;
  let (_,u5) = utime f5 n in
  Printf.printf "%8.2f" u5; flush stdout;
  let (_,u6) = utime f6 n in
  Printf.printf "%8.2f" u6; flush stdout;
  Printf.printf "\n"
  
let compare_times2 f1 f2 f3 f4 f5 f6 n m = 
  compare_times (f1 n) (f2 n) (f3 n) (f4 n) (f5 n) (f6 n) m

(* the sets implementations *)

(* Ocaml's AVLs *)
module S1 = struct
    module S = Set.Make(struct type t = int let compare x y = y - x end)

    type t = S.t
    let empty = S.empty
    let mem s = S.mem s
    let inter s1 s2  = S.inter s1 s2 
    let remove x s = S.remove x s
    let add x s = S.add x s
    let compare s1 s2 = S.compare s1 s2
    let subset s1 s2 = S.subset s1 s2
    let diff s1 s2 = S.diff s1 s2
    let union s1 s2 = S.union s1 s2
    let fold f s a = S.fold (fun x y -> f x y) s a
end
module B1 = struct let name = "Ocaml" include BenchSet(S1) end

(* James Woodyatt's red-black trees *)
module S2 = struct
    module S = Cf_rbtree.Set(Cf_ordered.Int_order)

    type t = S.t
    let empty = S.nil
    let mem s = S.member s
    let inter s1 s2 = S.intersect s1 s2
    let remove x s = S.clear x s
    let add x s = S.put x s
    let compare s1 s2 = S.compare s1 s2
    let subset s1 s2 = S.subset s1 s2
    let diff s1 s2 = S.diff s1 s2
    let union s1 s2 = S.union s1 s2
    let fold f s a = S.fold (fun x y -> f y x) a s
end
module B2 = struct let name = "Cf_rbtree.Set" include BenchSet(S2) end

module S3 = Dummy_set
module B3 = Dummy_bench

module S4 = Dummy_set
module B4 = Dummy_bench

module S5 = Dummy_set
module B5 = Dummy_bench

module S6 = Dummy_set
module B6 = Dummy_bench

module S7 = Dummy_set
module B7 = Dummy_bench

(****
(* red-black trees *)
module S2 = Rbset.Make(struct type t = int let compare = compare end)
module B2 = struct let name = "RBT" include BenchSet(S2) end

(* Patricia trees *)
module S3 = Ptset
module B3 = struct let name = "Patricia" include BenchSet(S3) end

(* SML red-black trees *)
module S4 = 
  Sml_rbt.Make(struct 
        type t = int 
        let compare (x,y) = let c = compare x y in
        if c < 0 then Sml_rbt.LESS 
        else if c = 0 then Sml_rbt.EQUAL else Sml_rbt.GREATER 
      end)
module B4 = struct let name = "SML-RBT" include BenchSet(S4) end

(* James Woodyatt's red-black trees *)
module S5 = struct
  let name = "JW-RBT"
  include Cf_rbset.Create(Cf_ordered.Int_order)
  let empty = null
  let mem = member
  let inter = intersect
  let remove = clear
  let add = put
  let fold f s a = fold (fun x y -> f y x) a s
end
module B5 = struct let name = "JW-RBT" include BenchSet(S5) end

(* extracted AVLs *)
module S6 = struct
  open Avl_extr
  module Int = struct 
    type t = int 
    let compare x y = 
      let c = compare x y in 
      if c < 0 then Lt else if c == 0 then Eq else Gt
  end
  module M = Avl_extr.Make(Int)
  include M
  let compare x y = match M.compare x y with Lt -> -1 | Eq -> 0 | Gt -> 1
end
module B6 = struct let name = "extr-AVL" include BenchSet(S6) end

(* extracted red-black trees *)
module S7 = struct
  open Rbt_extr
  module Int = struct 
    type t = int 
    let compare x y = 
      let c = compare x y in 
      if c < 0 then Lt else if c == 0 then Eq else Gt
  end
  module M = Rbt_extr.Make2(Int)
  include M
  let compare x y = match M.compare x y with Lt -> -1 | Eq -> 0 | Gt -> 1
end
module B7 = struct let name = "extr-RBT" include BenchSet(S7) end
 ****)


(* correctness check *)
let _ =
  printf "correctness check... "; flush stdout;
  for i = 1 to 10000 do
    let b = S1.mem i B1.rnd_10000 in
    assert (b == S2.mem i B2.rnd_10000);
    (*
    assert (b == S3.mem i B3.rnd_10000);
    assert (b == S4.mem i B4.rnd_10000);
    assert (b == S5.mem i B5.rnd_10000);
    assert (b == S6.mem i B6.rnd_10000)
    *)
  done;
  printf "ok\n\n"; flush stdout

let _ = 
  printf "         %8s %8s %8s %8s %8s %8s\n" 
    B1.name B2.name B3.name B4.name B5.name B6.name;
  printf "==============================================================\n"; 
  flush stdout

let _ =
  printf "add:\n"; flush stdout;
  printf "Sequential insertion\n"; flush stdout;
  compare_times 
    B1.build_seq B2.build_seq B3.build_seq B4.build_seq B5.build_seq
    B6.build_seq 1000;
  compare_times 
    B1.build_seq B2.build_seq B3.build_seq B4.build_seq B5.build_seq
    B6.build_seq 10000;
  compare_times 
    B1.build_seq B2.build_seq B3.build_seq B4.build_seq B5.build_seq
    B6.build_seq 100000;
  compare_times 
    B1.build_seq B2.build_seq B3.build_seq B4.build_seq B5.build_seq
    B6.build_seq 1000000;
  printf "Random insertion (few clashes)\n"; flush stdout;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 1000 1000;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 10000 10000;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 100000 100000;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 1000000 1000000;
  printf "Random insertion (many clashes)\n"; flush stdout;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 10 1000;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 100 10000;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 1000 100000;
  compare_times2 
    B1.build_rnd B2.build_rnd B3.build_rnd B4.build_rnd B5.build_rnd
    B6.build_rnd 10000 1000000;
  printf "\n";

  printf "mem:\n"; flush stdout;
  printf "Sequential lookup in sequential set\n";
  compare_times 
    B1.lookup_seq_seq B2.lookup_seq_seq 
    B3.lookup_seq_seq B4.lookup_seq_seq B5.lookup_seq_seq B6.lookup_seq_seq
    5000000;
  printf "Random lookup in sequential set\n";
  compare_times 
    B1.lookup_rnd_seq B2.lookup_rnd_seq 
    B3.lookup_rnd_seq B4.lookup_rnd_seq B5.lookup_rnd_seq B6.lookup_rnd_seq
    5000000;
  printf "Sequential lookup in random set\n";
  compare_times 
    B1.lookup_seq_rnd B2.lookup_seq_rnd 
    B3.lookup_seq_rnd B4.lookup_seq_rnd B5.lookup_seq_rnd B6.lookup_seq_rnd
    5000000;
  printf "Random lookup in random set\n";
  compare_times 
    B1.lookup_rnd_rnd B2.lookup_rnd_rnd 
    B3.lookup_rnd_rnd B4.lookup_rnd_rnd B5.lookup_rnd_rnd B6.lookup_rnd_rnd
    5000000;
  printf "\n";

  printf "remove:\n"; flush stdout;
  printf "Sequential remove in sequential set\n";
  compare_times 
    B1.remove_seq_seq B2.remove_seq_seq 
    B3.remove_seq_seq B4.remove_seq_seq B5.remove_seq_seq B6.remove_seq_seq 
    10000;
  printf "Random remove in sequential set\n";
  compare_times 
    B1.remove_rnd_seq B2.remove_rnd_seq 
    B3.remove_rnd_seq B4.remove_rnd_seq B5.remove_rnd_seq B6.remove_rnd_seq
    10000;
  printf "Sequential remove in random set\n";
  compare_times 
    B1.remove_seq_rnd B2.remove_seq_rnd 
    B3.remove_seq_rnd B4.remove_seq_rnd B5.remove_seq_rnd B6.remove_seq_rnd
    10000;
  printf "Random remove in random set\n";
  compare_times 
    B1.remove_rnd_rnd B2.remove_rnd_rnd 
    B3.remove_rnd_rnd B4.remove_rnd_rnd B5.remove_rnd_rnd B6.remove_rnd_rnd
    10000;
  printf "\n";

  printf "compare:\n"; flush stdout;
  compare_times 
    B1.bench_compare B2.bench_compare
    B3.bench_compare B4.bench_compare B5.bench_compare B6.bench_compare
    100;
  compare_times 
    B1.bench_compare B2.bench_compare
    B3.bench_compare B4.bench_compare B5.bench_compare B6.bench_compare
    1000;
  compare_times 
    B1.bench_compare B2.bench_compare
    B3.bench_compare B4.bench_compare B5.bench_compare  B6.bench_compare
    3000;
  printf "\n";
  
  printf "union:\n"; flush stdout;
  compare_times 
    B1.bench_union B2.bench_union
    B3.bench_union B4.bench_union B5.bench_union B6.bench_union 
    100;
  compare_times 
    B1.bench_union B2.bench_union
    B3.bench_union B4.bench_union B5.bench_union B6.bench_union 
    1000;
  compare_times 
    B1.bench_union B2.bench_union
    B3.bench_union B4.bench_union B5.bench_union B6.bench_union 
    3000;
  printf "\n";

  printf "inter:\n"; flush stdout;
  compare_times 
    B1.bench_inter B2.bench_inter
    B3.bench_inter B4.bench_inter B5.bench_inter B6.bench_inter 
    2000;
  printf "\n";

  printf "diff:\n"; flush stdout;
  compare_times 
    B1.bench_diff B2.bench_diff
    B3.bench_diff B4.bench_diff B5.bench_diff B6.bench_diff
    2000;
  printf "\n";

  printf "subset:\n"; flush stdout;
  compare_times 
    B1.bench_subset B2.bench_subset
    B3.bench_subset B4.bench_subset B5.bench_subset B6.bench_subset
    100;
  compare_times 
    B1.bench_subset B2.bench_subset
    B3.bench_subset B4.bench_subset B5.bench_subset B6.bench_subset
    1000;
  compare_times 
    B1.bench_subset B2.bench_subset
    B3.bench_subset B4.bench_subset B5.bench_subset B6.bench_subset
    3000;
  printf "\n";
  ()
