Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

code for binary heaps blog post

  • Loading branch information...
commit f53e4513b2bea9b03c8da10f252315f915737ae0 1 parent 30fd611
Jake Donham authored
View
5 _code/binary-heaps/Makefile
@@ -0,0 +1,5 @@
+all:
+ ocamlbuild heap.cmo kmin.cmo merge.cmo skyline.cmo
+
+clean:
+ ocamlbuild -clean
View
88 _code/binary-heaps/heap.ml
@@ -0,0 +1,88 @@
+module type OrderedType =
+sig
+ type t
+ val compare : t -> t -> int
+end
+
+module type S = sig
+ type elt
+ type t
+ val make : unit -> t
+ val add : t -> elt -> unit
+ val peek_min : t -> elt option
+ val take_min : t -> elt
+ val size : t -> int
+end
+
+module Make (O : OrderedType) : S with type elt = O.t =
+struct
+ type elt = O.t
+ type t = { mutable arr : elt array; mutable len : int }
+
+ let make () = { arr = [||]; len = 0; }
+
+ let compare h i1 i2 = O.compare h.arr.(i1) h.arr.(i2)
+
+ let swap h i1 i2 =
+ let t = h.arr.(i1) in
+ h.arr.(i1) <- h.arr.(i2);
+ h.arr.(i2) <- t
+
+ let rec up h i =
+ if i = 0 then ()
+ else
+ let p = (i - 1) / 2 in
+ if compare h i p < 0 then begin
+ swap h i p;
+ up h p
+ end
+
+ let rec down h i =
+ let l = 2 * i + 1 in
+ let r = 2 * i + 2 in
+ if l >= h.len then ()
+ else
+ let child =
+ if r >= h.len then l
+ else if compare h l r < 0 then l else r in
+ if compare h i child > 0 then begin
+ swap h i child;
+ down h child
+ end
+
+ let add h e =
+ if h.len = Array.length h.arr
+ then begin
+ let len = 2 * h.len + 1 in
+ let arr' = Array.make len (Obj.magic 0) in
+ Array.blit h.arr 0 arr' 0 h.len;
+ h.arr <- arr'
+ end;
+ h.arr.(h.len) <- e;
+ up h h.len;
+ h.len <- h.len + 1
+
+ let peek_min h =
+ match h.len with
+ | 0 -> None
+ | _ -> Some h.arr.(0)
+
+ let take_min h =
+ match h.len with
+ | 0 -> raise Not_found
+ | 1 ->
+ let m = h.arr.(0) in
+ h.arr.(0) <- (Obj.magic 0);
+ h.len <- 0;
+ m
+ | k ->
+ let m = h.arr.(0) in
+ let k = k - 1 in
+ h.arr.(0) <- h.arr.(k);
+ h.arr.(k) <- (Obj.magic 0);
+ h.len <- k;
+ down h 0;
+ m
+
+ let size h = h.len
+end
View
17 _code/binary-heaps/heap.mli
@@ -0,0 +1,17 @@
+module type OrderedType =
+sig
+ type t
+ val compare : t -> t -> int
+end
+
+module type S = sig
+ type elt
+ type t
+ val make : unit -> t
+ val add : t -> elt -> unit
+ val peek_min : t -> elt option
+ val take_min : t -> elt
+ val size : t -> int
+end
+
+module Make (O : OrderedType) : S with type elt = O.t
View
19 _code/binary-heaps/kmin.ml
@@ -0,0 +1,19 @@
+let kmin (type s) k l =
+ let module OT = struct
+ type t = s
+ let compare e1 e2 = compare e2 e1
+ end in
+ let module H = Heap.Make(OT) in
+
+ let h = H.make () in
+ List.iter
+ (fun e ->
+ H.add h e;
+ if H.size h > k
+ then ignore (H.take_min h))
+ l;
+ let rec loop mins =
+ match H.peek_min h with
+ | None -> mins
+ | _ -> loop (H.take_min h :: mins) in
+ loop []
View
23 _code/binary-heaps/merge.ml
@@ -0,0 +1,23 @@
+let merge (type s) ls =
+ let module OT = struct
+ type t = s list
+ let compare e1 e2 =
+ compare (List.hd e1) (List.hd e2)
+ end in
+ let module H = Heap.Make(OT) in
+
+ let h = H.make () in
+ let add = function
+ | [] -> ()
+ | l -> H.add h l in
+ List.iter add ls;
+ let rec loop () =
+ match H.peek_min h with
+ | None -> []
+ | _ ->
+ match H.take_min h with
+ | [] -> assert false
+ | m :: t ->
+ add t;
+ m :: loop () in
+ loop ()
View
41 _code/binary-heaps/skyline.ml
@@ -0,0 +1,41 @@
+type building = int * int * int (* x0, x1, h *)
+
+let skyline bs =
+ let module OT = struct
+ type t = int * building
+ let compare (x1, _) (x2, _) = compare x1 x2
+ end in
+ let module Events = Heap.Make(OT) in
+ let events = Events.make () in
+ List.iter
+ (fun ((x0,x1,_) as b) ->
+ Events.add events (x0, b);
+ Events.add events (x1, b))
+ bs;
+
+ let module OT = struct
+ type t = building
+ let compare (_,_,h1) (_,_,h2) = compare h2 h1
+ end in
+ let module Heights = Heap.Make(OT) in
+ let heights = Heights.make () in
+
+ let rec loop last =
+ match Events.peek_min events with
+ | None -> []
+ | _ ->
+ let (x, (x0,_,h as b)) = Events.take_min events in
+ if x = x0 then Heights.add heights b;
+ while (match Heights.peek_min heights with
+ | Some (_,x1,_) -> x1 <= x
+ | _ -> false) do
+ ignore (Heights.take_min heights)
+ done;
+ let h =
+ match Heights.peek_min heights with
+ | Some (_,_,h) -> h
+ | None -> 0 in
+ match last with
+ | Some h' when h = h' -> loop last
+ | _ -> (x, h) :: loop (Some h) in
+ loop None
Please sign in to comment.
Something went wrong with that request. Please try again.