Commits

jhwoodyatt  committed 0987900

Submit cf-0.2 release.

  • Participants
  • Parent commits a921d09
  • Tags cf-0_2

Comments (0)

Files changed (2)

File cf/t/t_cf.ml

 *)
 
 module T1 = struct
-    module R = Cf_rbtree.Create(Cf_ordered.Int_order)
+    module R = Cf_rbtree.Map(Cf_ordered.Int_order)
     open R
     
+    let decreasing = to_seq_decr
+    
     let rec printlist s nl =
         (*
         Printf.printf "%s: [" s;
 end
 
 module T2 = struct
-    open Cf_set
+    (* open Cf_rbset *)
         
     module S1 = Set.Make(Cf_ordered.Int_order)
-    module S2 = Cf_set.Create(Cf_ordered.Int_order)
+    module S2 = Cf_rbtree.Set(Cf_ordered.Int_order)
     
     let bound = 64
     let iterations = 512
                 "add failure", S1.add x s1, S2.put x s2
         in
         let n = pred n in
-        let e1 = S1.elements s1 and e2 = S2.elements s2 in
+        let e1 = S1.elements s1 and e2 = S2.to_list_incr s2 in
         (*
         print_list "e1" e1;
         print_list "e2" e2;
         if n > 0 then loop n s1 s2
     
     let test () =
-        loop iterations S1.empty S2.null
+        loop iterations S1.empty S2.nil
 end
 
 module T3 = struct
-    module IntOrder = struct type t = int let compare = compare end
-    module M = Cf_rbtree.Create(IntOrder)
+    module M = Cf_rbtree.Map(Cf_ordered.Int_order)
     
     let test1 () =
         let m = M.replace (0, "zero") M.nil in
         let s = M.search 0 m in
         assert (s = "zero")
     
+    let nearest_succ key m =
+        match Lazy.force (M.nearest_incr key m) with
+        | Cf_seq.Z ->
+            raise Not_found
+        | Cf_seq.P (hd, _) ->
+            hd
+    
+    let nearest_pred key m =
+        match Lazy.force (M.nearest_decr key m) with
+        | Cf_seq.Z ->
+            raise Not_found
+        | Cf_seq.P (hd, _) ->
+            hd
+    
     let test2 () =
         let m = [
             1, "one";
             19, "nineteen";
         ] in
         let m = M.of_list m in
-        if M.nearest_succ 0 m <> (1, "one") then
+        if nearest_succ 0 m <> (1, "one") then
             failwith "nearest_succ 0";
-        if M.nearest_succ 1 m <> (1, "one") then
+        if nearest_succ 1 m <> (1, "one") then
             failwith "nearest_succ 01";
-        if M.nearest_succ 2 m <> (3, "three") then
+        if nearest_succ 2 m <> (3, "three") then
             failwith "nearest_succ 2";
-        if M.nearest_pred 20 m <> (19, "nineteen") then
+        if nearest_pred 20 m <> (19, "nineteen") then
             failwith "nearest_pred 20";
-        if M.nearest_pred 19 m <> (19, "nineteen") then
+        if nearest_pred 19 m <> (19, "nineteen") then
             failwith "nearest_pred 19";
-        if M.nearest_pred 18 m <> (17, "seventeen") then
+        if nearest_pred 18 m <> (17, "seventeen") then
             failwith "nearest_pred 18";
         ()
     
 
 module T6 = struct
     open Printf
-    
+    open Cf_lexer.Op
+    open Cf_parser.Op
+        
     module L1 = struct
-        open Cf_lexer.Op
-        open Cf_parser.Op
-        
-        let lexer = Cf_lexer.create begin
-            (!*(!:'a' $| !:'b')) $& !$"abb" $^ (fun x -> x)
-        end
-        
         let cursor_ = new Cf_lexer.line_cursor "\n"
         
-        let test1 () =
+        let test1 lexer =
             let token0 = "abaabaababbabb" in
             let input = token0 (* ^ "jhw" *) in
             let s = Cf_seq.of_substring input 0 in
             if token <> token0 then
                 failwith (sprintf "Bad match! [msg='%s']" token)
         
-        let test2 () =
+        let test2 lexer =
             let token0 = "abaabaababbabb" in
             let input = token0 ^ "jhw" in
             let s = Cf_seq.of_substring input 0 in
                 failwith (sprintf "Bad match! [msg='%s']" token)
     end
 
-    let test () = L1.test1 (); L1.test2 ()
+    let test () =
+        let lexer =
+            Cf_lexer.create begin
+                (!*(!:'a' $| !:'b')) $& !$"abb" $^ (fun x -> x)
+            end
+        in
+        L1.test1 lexer;
+        L1.test2 lexer
 end
 
 module T7 = struct
         ignore (Unix.sigprocmask Unix.SIG_SETMASK save)
 end
 
+module T16 = struct
+    open Cf_scmonad.Op
+    
+    module String_set = Cf_rbtree.Set(String)
+    
+    (* val memoize: (string, string) Cf_flow.t *)
+    let memoize =
+        let rec loop () =
+            Cf_flow.readSC >>= fun s ->
+            Cf_scmonad.load >>= fun u ->
+            if String_set.member s u then
+                loop ()
+            else
+                let u = String_set.put s u in
+                Cf_scmonad.store u >>= fun () ->
+                Cf_flow.writeSC s >>= fun () ->
+                loop ()
+        in
+        Cf_flow.evalSC (loop ()) String_set.nil
+    
+    (* val uniq: string list -> string list *)
+    let uniq s =
+        let z = Cf_seq.of_list s in
+        let z = Cf_flow.commute memoize z in
+        Cf_seq.to_list z
+    
+    let test () =
+        let s1 = [ "Hello"; "World!"; "Hello"; "AGAIN!" ] in
+        let s2 = [ "Hello"; "World!"; "AGAIN!" ] in
+        let s2' = uniq s1 in
+        if s2 <> s2' then failwith "Error in uniq!"
+end
+
 let main () =
     let tests = [
         T1.test; T2.test; T3.test; T4.test; T5.test;
         T6.test; T7.test; T8.test; T9.test; T10.test;
-        T11.test; T12.test; T13.test; T14.test; T15.test
+        T11.test; T12.test; T13.test; T14.test; T15.test;
+        T16.test
     ] in
     Printf.printf "1..%d\n" (List.length tests);
     flush stdout;

File cf/t/t_setbench.ml

+
+(* 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_rbt.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_rbt.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";
+  
+  ()