1 files changed, 83 insertions, 0 deletions
diff --git a/lo3.ml b/lo3.ml
new file mode 100644
index 0000000..7693f69
--- /dev/null
+++ b/lo3.ml
@@ -0,0 +1,83 @@
+(* Generic binary heaps. *)
+module Heap: sig
+  type 'a t
+  val create: ('a -> 'a -> int) -> 'a t
+  val add: 'a t -> 'a -> unit
+  val pop: 'a t -> 'a option
+  val top: 'a t -> 'a option
+end = struct
+  type 'a t =
+    { mutable arr: 'a array
+    ; mutable len: int
+    ; cmp: 'a -> 'a -> int
+    }
+
+  let mkarray n = Array.make n (Obj.magic 0)
+  let create cmp = {arr = mkarray 2; len = 0; cmp }
+  let top {arr; len; _} =
+    if len = 0 then None else Some arr.(1)
+  let swap arr i j =
+    let tmp = arr.(i) in
+    arr.(i) <- arr.(j);
+    arr.(j) <- tmp
+
+  let rec bblup cmp arr i =
+    let prnt = i/2 in
+    if prnt = 0 then () else
+    if cmp arr.(prnt) arr.(i) < 0 then () else
+    (swap arr prnt i; bblup cmp arr prnt)
+  let add ({arr; len; cmp} as hp) x =
+    let arr =
+      let alen = Array.length arr in
+      if alen > len+1 then arr else
+      let arr' = mkarray (alen * 2) in
+      Array.blit arr 0 arr' 0 alen;
+      hp.arr <- arr';
+      arr' in
+    hp.len <- len + 1;
+    arr.(hp.len) <- x;
+    bblup cmp arr hp.len
+
+  let rec bbldn cmp arr i len =
+    let ch0 = 2*i in
+    let ch1 = ch0 + 1 in
+    if ch0 > len then () else
+    let mn =
+      if ch1 > len then ch0 else
+      if cmp arr.(ch0) arr.(ch1) < 0
+      then ch0 else ch1 in
+    if cmp arr.(i) arr.(mn) <= 0 then () else
+    (swap arr i mn; bbldn cmp arr mn len)
+  let pop ({arr; len; cmp} as hp) =
+    if len = 0 then None else
+    let t = top hp in
+    arr.(1) <- arr.(len);
+    hp.len <- len - 1;
+    bbldn cmp arr 1 len;
+    t
+end
+
+let rec popall h =
+  match Heap.pop h with
+  | None -> []
+  | Some x -> x :: popall h
+
+let _ =
+  if true then
+  let rnd () =
+    (2047 land Random.bits ()) *
+    ((Random.bits () land 2) - 1) in
+  let rec f n = if n = 0 then [] else rnd () :: f (n-1) in
+  for n = 1 to 150 do
+    for i = 1 to 1_000 do
+      let l = f n in
+      (* List.iter (Printf.printf "%d, ") l; print_newline (); *)
+      let h = Heap.create compare in
+      List.iter (Heap.add h) l;
+      let l' = popall h in
+      assert (List.sort compare l = l');
+    done;
+    Printf.printf "... %d\n" n;
+    flush stdout;
+  done;
+  print_string "OK!\n"