Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(* Binomial Heap *)
module type ORDERED =
sig
type t
val eq : t -> t -> bool
val lt : t -> t -> bool
val leq : t -> t -> bool
end
module type HEAP =
sig
module Elem : ORDERED
type heap
val empty : heap
val is_empty : heap -> bool
val insert :heap -> Elem.t -> heap
val merge : heap -> heap -> heap
val find_min : heap -> Elem.t (* raises Empty if heap is empty *)
val delete_min : heap -> heap (* raises Empty if heap is empty *)
end
module BinomialHeap
(Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module Elem = Element
type tree = Node of int * Elem.t * tree list
type heap = tree list
exception Empty
let empty = []
let is_empty ts = ts = empty
let rank (Node(r, _, _)) = r
let root (Node(_, x, _)) = x
let link (Node(r, x1, c1) as t1) (Node(_, x2, c2) as t2) =
if Elem.leq x1 x2 then Node(r + 1, x1, t2::c1)
else Node(r + 1, x2, t1::c2)
let rec merge_tree t tt =
match tt with
[] -> [t]
| t'::ts' as ts ->
if rank t < rank t' then t::ts
else merge_tree (link t t') ts'
let insert ts x = merge_tree (Node(0, x, [])) ts
let rec merge ts1 ts2 =
match ts1, ts2 with
_, [] -> ts1
| [], _ -> ts2
| t1::ts1', t2::ts2' ->
if rank t1 < rank t2 then t1::(merge ts1' ts2)
else if rank t2 < rank t1 then t2::(merge ts1 ts2')
else merge_tree (link t1 t2) (merge ts1' ts2')
let rec remove_min_tree tree_ =
match tree_ with
[] -> raise Empty
| [t] -> (t, [])
| t::ts ->
let t', ts' = remove_min_tree ts in
if Elem.leq (root t) (root t') then (t, ts)
else (t', t::ts')
let find_min ts = root (fst (remove_min_tree ts))
let delete_min ts =
let Node(_, x, ts1) , ts2 = remove_min_tree ts in
merge (List.rev ts1) ts2
end
(*
(* test *)
module IntHeap = BinomialHeap(
struct
type t = int
let eq x y = x = y
let lt x y = x < y
let leq x y = x <= y
end
)
open IntHeap;;
let a = insert empty 1;;
let a = insert a 5;;
let a = insert a 9;;
let a = insert a 2;;
let a = insert a 3;;
let a = insert a 8;;
let a = insert a 4;;
find_min a;;
let a = delete_min a;;
find_min a;;
*)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.