Module Heap
open Basic
module type HEAP =
sig
type elem
type heap = Leaf | Node of heap × elem × heap
val empty: heap
val is_empty: heap ® bool
val insert: heap ® elem ® heap
val delete_max: heap ® (elem × heap)
val get_max: heap ® elem
val heap_of_list: elem list ® heap
end
module type MHEAP = (* Heap with merging *)
sig
type elem
type heap
val empty: heap
val is_empty: heap ® bool
val merge: heap ® heap ® heap
val insert: heap ® elem ® heap
val delete_max: heap ® (elem × heap)
val get_max: heap ® elem
val heap_of_list: elem list ® heap
end
module HeapFun (E:ORDERED) : (HEAP with type elem = E.t) =
struct
type elem = E.t
type heap = Leaf | Node of heap × elem × heap
(* ------------------------------------------ *)
let empty = Leaf
let is_empty h = match h with
Leaf ® true
| _ ® false
let rec insert (h:heap) (e:elem) =
match h with
Leaf ® Node (Leaf,e,Leaf)
| Node(h_l,e',h_r) ®
let (max,min) = (if (E.gt (e,e')) then (e,e') else (e',e))
in Node(insert h_r min , max, h_l)
let rec delete (h: heap) =
(* deleting a leaf-element, and giving it back, too *)
(* Stucturually, it's the reverse of insert. *)
(* The left subtree has always one element more *)
(* than the right subtree or the same elements *)
match h with
Leaf ® raise (Failure "Empty heap")
| Node(Leaf,e,Leaf) ® (Leaf,e)
| Node (Leaf,_,_) ® raise (Failure "cannot happend")
| Node (h_l,e,h_r) ®
let (h_l', e') = delete h_l
in (Node (h_r,e,h_l'),e')
let get_max (h: heap) =
match h with
Leaf ® raise (Failure "2Empty heap")
| Node(_,e,_) ® e
let max3 (e1,e2,e3) =
match (E.geq(e1,e2), E.geq(e2,e3), E.geq(e1,e3))
with
(true,_,true) ® e1
| (false,true,_) ® e2
| (_,false,false) ® e3
| _ ® raise (Failure "Must not happen")
let rec siftdown h =
(* taking 2 heaps and an element, give back the combined heap.
The structure of Node(h1,e,h2) is not changed. *)
match h with
Leaf ® Leaf
| Node(h1,e,h2) ®
(match (h1,h2) with
(Leaf,Leaf) ® h
| (Node(h1_l,e',h1_r), Leaf) ®
if E.geq(e,e')
then Node (h1,e,Leaf)
else Node (siftdown (Node(h1_l,e,h1_r)),e',Leaf)
|
(Node(h1_l,e',h1_r), Node(h2_l,e'',h2_r))
®
let m = max3 (e,e',e'')
in if E.eq(e, m) then h
else if E.eq(e',m) then
Node(siftdown (Node(h1_l,e,h1_r)),e',h2)
else
Node(h1,e'',siftdown (Node(h2_l,e,h2_r)))
)
let delete_max (h: heap) =
match h with
Leaf ® raise (Failure "Empty heap")
| Node(Leaf,e,Leaf) ® (e,Leaf)
| Node(h_l,e,h_r) ®
let (h_l',e') = delete h_l
in (e, siftdown (Node(h_r,e',h_l')))
let rec heap_of_list l =
match l with
[ ] ® Leaf
| e::l' ® insert (heap_of_list l') e;
end
------------------------------
module MHeapFun (E:ORDERED) : (MHEAP with type elem = E.t) =
struct
type elem = E.t
type rank = int
type heap = Leaf | Node of heap × rank × elem × heap
let empty = Leaf
let is_empty h =
match h with
Leaf ® true
| _ ® false
let rank (h: heap) =
match h with
Leaf ® 0
| Node(_,r,_,_) ® r
let makeNode (h1,e,h2) =
if (rank h1) ³ (rank h2)
then Node(h1,(rank h2) + 1,e,h2)
else Node(h2,(rank h1) + 1,e,h1)
let rec merge h1 h2 =
match (h1,h2) with
(Leaf, _) ® h2
| (_, Leaf) ® h1
| (Node(h1_l,r1,e1,h1_r),Node(h2_l,r2,e2,h2_r)) ®
if E.geq(e1,e2)
then makeNode(h1_l,e1, merge h1_r h2)
else makeNode(h2_l,e2,merge h1 h2_r)
let insert h e = merge h (Node(Leaf,1,e,Leaf))
let get_max h = match h with
Leaf ® raise (Failure "Empty heap")
| Node(_,_,e,_) ® e
let delete_max h = match h with
Leaf ® raise (Failure "Empty heap")
| Node(h1,r,e,h2) ® (e, merge h1 h2)
let rec heap_of_list l =
match l with
[ ] ® Leaf
| e::l' ® insert (heap_of_list l') e;
end
January 31, 2002