Previous Contents Next

Module Heap

open Basic

module type HEAP = 
   sig
     type elem
     type heap = Leaf | Node of heap × elem × heap

     val emptyheap
     val is_emptyheap ® bool
     val insertheap ® elem ® heap
     val delete_maxheap ® (elem × heap)
     val get_maxheap ® elem
     val heap_of_listelem list ® heap
   end

module type MHEAP = (* Heap with merging *)
   sig
     type elem
     type heap

     val emptyheap
     val is_emptyheap ® bool
     val mergeheap ® heap ® heap
     val insertheap ® elem ® heap
     val delete_maxheap ® (elem × heap)
     val get_maxheap ® elem
     val heap_of_listelem 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 , maxh_l)

     let rec delete (hheap) = 
     (* 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 (hheap) =
       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,h2with 
             (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(emthen h
                 else if E.eq(e',mthen
                   Node(siftdown (Node(h1_l,e,h1_r)),e',h2)
                 else 
                   Node(h1,e'',siftdown (Node(h2_l,e,h2_r)))
             )

     let delete_max (hheap) =
       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 (esiftdown (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 (hheap) = 
       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,h2with
         (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,e1merge 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® (emerge h1 h2)

     let rec heap_of_list l =
       match l with 
         [ ] ® Leaf
       | e::l' ® insert (heap_of_list l'e;

   end


January 31, 2002
Previous Contents Next