binomialHeap.ml

(* 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;;
*)