Commits

David Powers  committed ab152de

more tests

  • Participants
  • Parent commits deaa654

Comments (0)

Files changed (3)

File low/trees/map_intf.ml

 module type S = sig
-  type 'a t
+  type t
 
   val name : string
 
-  val empty : 'a t
+  val empty : t
 
-  val find : 'a t -> 'a -> 'a option
-  val insert : 'a t -> 'a -> 'a t
-  val remove : 'a t -> 'a -> 'a t
+  val find : t -> int -> int option
+  val insert : t -> int -> t
+  val remove : t -> int -> t
 end

File low/trees/test_harness.ml

 module Generator : sig
   type t
 
-  val create : init:(unit -> 'state) -> ('state -> int * 'state) -> t
+  val create : name:string -> init:(unit -> 'state) -> ('state -> int * 'state) -> t
+  val name : t -> string
   val reset : t -> unit
   val next : t -> int
   val iter_n : t -> int -> (int -> unit) -> unit
 end = struct
   type t =
     {
+      name  : string;
       reset : (unit -> unit);
       next  : (unit -> int)
     }
 
-  let create ~init f =
+  let create ~name ~init f =
     let current_state = ref (init ()) in
     let next () =
       let v, next_state = f !current_state in
       v
     in
     let reset () = current_state := init () in
-    { reset; next }
+    { name; reset; next }
   ;;
 
+  let name t = t.name
   let reset t = t.reset ()
   let next t = t.next ()
 
   ;;
 end
 
-let in_order      = Generator.create ~init:(fun () -> 0) (fun v -> v, v + 1)
-let reverse_order = Generator.create ~init:(fun () -> max_int) (fun v -> v, v - 1)
+let in_order      =
+  Generator.create ~name:"in-order" ~init:(fun () -> 0) (fun v -> v, v + 1)
+;;
+
+let reverse_order =
+  Generator.create ~name:"reverse-order" ~init:(fun () -> max_int) (fun v -> v, v - 1)
+;;
 
 let random =
   let init () = Random.State.make [| 1; 7; 23; 4 |] in
-  Generator.create ~init (fun s -> Random.State.bits s, s)
+  Generator.create ~name:"random" ~init (fun s -> Random.State.bits s, s)
 ;;
 
+let generators = [
+  in_order;
+  reverse_order;
+  random
+]
+
+let test_sizes = [
+  1;
+  10;
+  100;
+  200;
+  500;
+  1_000;
+  5_000;
+  10_000;
+  100_000;
+  1_000_000;
+]
+
 module Test : sig
   type t
 
-  val run : t -> (module Map_intf.S) -> unit
-  val create : name:string -> ((module Map_intf.S) -> unit) -> t
+  val run : t -> unit
+  val create : name:string -> (unit -> unit) -> t
 end = struct
   type t = {
     name : string;
-    f : (module Map_intf.S) -> unit
+    f : unit -> unit
   }
 
   let create ~name f = { name; f }
 
-  let run t map_module =
-    let module Map = (val map_module : Map_intf.S) in
-    Printf.printf "running: %s on %s\n" t.name Map.name;
-    t.f map_module
+  let run t =
+    Printf.printf "running: %s\n%!" t.name;
+    t.f ()
   ;;
 end
 
-let tests = [
-  Test.create "in-order insert" (fun map_module ->
+module Maps = struct
+  module OCaml_map = struct
+    module Set =
+      Set.Make(struct
+        type t = int
+        let compare (t1:int) (t2:int) = compare t1 t2
+      end)
+
+    type t = Set.t
+
+    let name = "ocaml"
+    let empty = Set.empty
+    let insert t v = Set.add v t
+    let remove v t = Set.remove t v
+    let find t v = if Set.mem v t then Some v else None
+  end
+
+  module Treap = struct
+    type t = int Treap.t
+
+    let empty  = Treap.empty
+    let name   = Treap.name
+    let insert = Treap.insert
+    let remove = Treap.remove
+    let find   = Treap.find
+  end
+
+  module Unbalanced = struct
+    type t = int Unbalanced_tree.t
+
+    let empty  = Unbalanced_tree.empty
+    let name   = Unbalanced_tree.name
+    let insert = Unbalanced_tree.insert
+    let remove = Unbalanced_tree.remove
+    let find   = Unbalanced_tree.find
+  end
+
+  module Hash = struct
+    module Int_hash = Hashtbl.Make (struct
+      type t = int
+
+      let equal (t1:int) (t2:int) = t1 = t2
+      let hash t = t
+    end)
+
+    type t = unit Int_hash.t
+
+    let empty = Int_hash.create 1
+    let name = "hash"
+    let insert t v = Int_hash.replace t v (); t
+    let remove t v = Int_hash.remove t v; t
+
+    let find t v =
+      try
+        ignore (Int_hash.find t v);
+        Some v
+      with
+      | Not_found -> None
+    ;;
+  end
+
+  let all = [
+    (module OCaml_map : Map_intf.S);
+    (module Treap : Map_intf.S);
+    (module Hash : Map_intf.S);
+    (*(module Unbalanced : Map_intf.S);*)
+  ]
+end
+
+
+module Tests = struct
+  let insert_test map_module gen size =
     let module Map = (val map_module : Map_intf.S) in
-    let _ =
-      Generator.fold_n in_order 1_000 ~init:Map.empty (fun acc i -> Map.insert acc i)
+    let name = Printf.sprintf "%s insert (%s) (%i)" (Generator.name gen) Map.name size in
+    Test.create name (fun () ->
+      Generator.reset gen;
+      let _ =
+        Generator.fold_n gen size ~init:Map.empty (fun acc i -> Map.insert acc i)
+      in
+      ())
+  ;;
+
+  let find_test map_module gen size =
+    let module Map = (val map_module : Map_intf.S) in
+    let name = Printf.sprintf "%s find (%s) (%i)" (Generator.name gen) Map.name size in
+    Generator.reset gen;
+    let map =
+      Generator.fold_n gen size ~init:Map.empty (fun acc i -> Map.insert acc i)
     in
-    ())
-]
+    Test.create name (fun () ->
+      Generator.reset gen;
+      Generator.iter_n gen size (fun i ->
+        match Map.find map i with
+        | None -> failwith (Printf.sprintf "expected to find %i in %s" i Map.name)
+        | Some _ -> ()))
+  ;;
 
-let map_modules = [
-  (module Treap : Map_intf.S);
-  (module Unbalanced_tree : Map_intf.S);
-]
+  let find_common_test map_module gen size =
+    let module Map = (val map_module : Map_intf.S) in
+    let name = Printf.sprintf "%s find (%s) (%i)" (Generator.name gen) Map.name size in
+    Generator.reset gen;
+    let map =
+      Generator.fold_n gen size ~init:Map.empty (fun acc i -> Map.insert acc i)
+    in
+    Generator.reset gen;
+    Test.create name (fun () ->
+      Generator.reset gen;
+      Generator.iter_n gen size (fun i ->
+        match Map.find map i with
+        | None -> failwith (Printf.sprintf "expected to find %i in %s" i Map.name)
+        | Some _ -> ()))
+  ;;
+
+
+  let remove_test map_module gen size =
+    let module Map = (val map_module : Map_intf.S) in
+    let name = Printf.sprintf "%s remove (%s) (%i)" (Generator.name gen) Map.name size in
+    Generator.reset gen;
+    let map =
+      Generator.fold_n gen size ~init:Map.empty (fun acc i -> Map.insert acc i)
+    in
+    Test.create name (fun () ->
+      Generator.reset gen;
+      let empty_map =
+        Generator.fold_n gen size ~init:map (fun acc i -> Map.remove acc i)
+      in
+      assert (empty_map = Map.empty))
+  ;;
+
+  let constructors = [
+    insert_test;
+    find_test;
+    remove_test;
+  ]
+
+  let all =
+    List.concat (List.map constructors ~f:(fun f ->
+      List.concat (List.map generators ~f:(fun gen ->
+        List.concat (List.map test_sizes ~f:(fun size ->
+          List.map Maps.all ~f:(fun map_module ->
+            f map_module gen size)))))))
+  ;;
+end
 
 let run_tests () =
-  List.iter tests ~f:(fun test ->
-    List.iter map_modules ~f:(fun map -> Test.run test map))
+  List.iter Tests.all ~f:(fun test -> Test.run test)
 ;;
 
 let () = run_tests ()

File low/trees/unbalanced_tree.ml

   | Empty -> Node (Empty, v, Empty)
   | Node (l, v', r) ->
     let c = compare v v' in
-    if c < 0 then insert l v
-    else if c > 0 then insert r v
+    if c < 0 then Node (insert l v, v', r)
+    else if c > 0 then Node (l, v', insert r v)
     else t
 ;;
 
 let rec merge t1 t2 =
   match t1,t2 with
-  | Empty, Empty -> Empty
-  | Empty, _     -> t2
-  | _, Empty     -> t1
-  | _, Node (rl, rv, rr) ->
-    Node (merge t1 rl, rv, rr)
+  | Empty, Empty         -> Empty
+  | Empty, _             -> t2
+  | _, Empty             -> t1
+  | _, Node (rl, rv, rr) -> Node (merge t1 rl, rv, rr)
 ;;
 
 let rec remove t v =
 
 let rec find t v =
   match t with
-  | Empty          -> None
+  | Empty           -> None
   | Node (l, v', r) ->
     let c = compare v v' in
     if c < 0 then find l v