Commits

David Powers committed 2766ce2

more tree work

Comments (0)

Files changed (5)

low/trees/map_interface.ml

+module type S = sig
+  type '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
+end

low/trees/red_black.ml

 type 'a t =
   | Red of 'a t * 'a * 'a t
   | Black of 'a t * 'a * 'a t
-  | Leaf
+  | Empty
 
-let empty = Leaf
+let empty = Empty
 
 let balance_left t =
   match t with
 
 let rec insert' t v =
   match t with
-  | Leaf -> Red (Leaf, v, Leaf)
+  | Empty -> Red (Empty, v, Empty)
   (* these two cases are almost identical, but need to be split out because we use the
      variant constructor to hold the color. *)
   | Black (l, v', r) ->
       balance_right (Red (l, v', insert' r v))
     else
       t
+;;
 
 let insert t v =
   match insert' t v with
   | Black _ as t  -> t
   | Red (l, v, r) -> Black (l, v, r)
-  | Leaf           -> assert false
+  | Empty           -> assert false
 ;;
 
 let rec find t v =
   match t with
-  | Leaf -> None
+  | Empty -> None
   | Red (l, v', r)
   | Black (l, v', r) ->
     let c = compare v v' in
     else Some v'
 ;;
 
-let flip_color t =
-  match t with
-  | Red (l, v, r) -> Black (l, v, r)
-  | Black (l, v, r) -> Red (l, v, r)
-  | Nil -> assert false
-;;
-
 let delete t v =
 
-  private Node moveRedLeft(Node h)
-{
-   colorFlip(h);
-   if (isRed(h.right.left))
-   {
-      h.right = rotateRight(h.right);
-      h = rotateLeft(h);
-      colorFlip(h);
-}
-return h; }
-private Node moveRedRight(Node h)
-{
-    colorFlip(h);
-    if (isRed(h.left.left))
-    {
-       h = rotateRight(h);
-       colorFlip(h);
-    }
-return h; }
-public void delete(Key key)
-{
-   root = delete(root, key);
-   root.color = BLACK;
-}
-private Node delete(Node h, Key key)
-{
-    if (key.compareTo(h.key) < 0)
-        {
-            if (!isRed(h.left) && !isRed(h.left.left))
-                h = moveRedLeft(h);
-            h.left =  delete(h.left, key);
-        }
-else {
-if (isRed(h.left))
-    h = rotateRight(h);
-if (key.compareTo(h.key) == 0 && (h.right == null))
-    return null;
-if (!isRed(h.right) && !isRed(h.right.left))
-    h = moveRedRight(h);
-if (key.compareTo(h.key) == 0)
-    {
-        h.val = get(h.right, min(h.right).key);
-        h.key = min(h.right).key;
-        h.right = deleteMin(h.right);
-    }
-else h.right = delete(h.right, key);
-}
-    return fixUp(h);
-}
 
 
 let main () =

low/trees/test_harness.ml

+module Data_generator : sig
+  type t
+
+  val create : init:(unit -> 'state) -> ('state -> int * 'state) -> t
+  val reset : t -> unit
+  val next : t -> int
+end = struct
+  type t =
+    {
+      reset : (unit -> unit);
+      next  : (unit -> int)
+    }
+
+  let create ~init f =
+    let current_state = ref (init ()) in
+    let next () =
+      let v, next_state = f !current_state in
+      current_state := next_state;
+      v
+    in
+    let reset () = current_state := init () in
+    { reset; next }
+  ;;
+
+  let reset t = t.reset ()
+  let next t = t.next ()
+end
+
+let in_order      = Data_generator.create ~init:(fun () -> 0) (fun v -> v, v + 1)
+let reverse_order = Data_generator.create ~init:(fun () -> max_int) (fun v -> v, v - 1)
+
+let random =
+  let init () = Random.State.make [| 1; 7; 23; 4 |] in
+  Data_generator.create ~init (fun s -> Random.State.bits s, s)
+;;

low/trees/treap.ml

   | Some t -> t
 ;;
 
+module type Map : sig
+  module type Key : sig
+    type t
+  end
+
+  type 'a t
+
+  val empty : 'a t
+
+  val find : 'a t -> Key.t -> 'a option
+  val add : 'a t -> key:Key.t -> data:'a -> 'a t
+  val remove : 'a t -> Key.t -> 'a t
+end
+
 let test () =
   Random.self_init ();
-  let max = 1_000_000_000 in
+  let max = 10_000_000 in
   let rec loop acc n =
     if n = 0 then acc
     else loop (add acc n) (n - 1)

low/trees/unbalanced_tree.ml

+type 'a t =
+  | Empty
+  | Node of 'a t * 'a * 'a t
+
+let empty = Empty
+
+let rec insert t v =
+  match t with
+  | 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
+    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)
+;;
+
+let rec remove t v =
+  match t with
+  | Empty -> t
+  | Node (l, v', r) ->
+    let c = compare v v' in
+    if c < 0 then remove l v
+    else if c > 0 then remove r v
+    else merge l r
+;;
+
+let rec find t v =
+  match t with
+  | Empty          -> None
+  | Node (l, v', r) ->
+    let c = compare v v' in
+    if c < 0 then find l v
+    else if c > 0 then find r v
+    else Some v'
+;;