-- Package: Binary_Heap_Pack declerations -- by George North -- Fall 1994 ---- Problem: provied a generic Binary Heap
-- ======================================================================
generic type Element_Type is private; with function ">" ( Left, Right : Element_Type ) return boolean; with procedure put( Element : Element_Type ); Min_Element : Element_Type;
-- ======================================================================
package Binary_Heap_Pack is
type Array_of_Element_Type is array(natural range <>) of Element_Type; type Priority_Queue( Max_Size: positive) is limited private;
-- ======================================================================
-- Procedure: Make_Null -- Precondition: none -- Postcondition: empty Binary Heap
procedure Make_Null( H : out Priority_Queue );
-- ======================================================================
-- Procedure: Insert -- Precondition: valid Binary Heap -- Postcondition: new Element in heap, or error Heap Overflow
procedure Insert( X : Element_Type; H : in out Priority_Queue );
-- ======================================================================
-- Procedure: Delete_Min -- Precondition: valid Binary Heap -- Postcondition: remove Top and return element, or Heap Underflow
procedure Delete_Min( Min : out Element_Type; H : in out Priority_Queue );
-- ======================================================================
-- Function: Find_Min -- Precondition: valid Binary Heap -- Postcondition: return smallest element, or Heap Underflow
function Find_Min( H : Priority_Queue ) return Element_Type;
-- ======================================================================
-- Function: Is_Empty -- Precondition: valid Binary Heap -- Postcondition: none
function Is_Empty( H : Priority_Queue ) return boolean;
-- ======================================================================
-- Function: Is_Full -- Precondition: valid Binary Heap -- Postcondition: none
function Is_Full( H : Priority_Queue ) return boolean;
-- ======================================================================
-- Procedure: Build_Heap -- Precondition: valid Array of elements -- Postcondition: new Binary Heap
procedure Build_Heap( Num : in natural; -- # of elements for heap Raw_Data : in Array_of_Element_Type; -- raw data H : out Priority_Queue);
-- ======================================================================
-- Procedure: Print Heap -- to check correctness of Heap -- Precondition: valid Binary Heap -- Postcondition: none
procedure Print_Heap( H : in Priority_Queue);
-- ======================================================================
Overflow : exception; Underflow : exception;
-- ======================================================================
private type Priority_Queue(Max_Size : positive) is record Size : natural :=0; Elements : Array_of_Element_Type( 0..Max_Size ); end record;
-- ======================================================================
end Binary_Heap_Pack;
-- ====================================================================== -- ======================================================================
-- Package Body: Binary_Heap_Pack
-- ======================================================================
with Text_IO; use Text_IO;
-- ======================================================================
package body Binary_Heap_Pack is
-- ======================================================================
procedure Make_Null( H : out Priority_Queue ) is
begin -- Make_Null H.Size := 0; H.Elements( 0 ) := Min_Element; end Make_Null;
-- ======================================================================
procedure Insert( X : Element_Type; H : in out Priority_Queue ) is
I : Natural;
begin -- Insert if Is_Full( H ) then raise Overflow; end if;
-- maka a hole H.Size := H.Size + 1; I := H.Size;
-- bubble up while H.Elements( I/2 ) > X loop -- Invariant : The top 1st element of Heap is always the smallest -- element. The 0th element of Heap is a Sentinal -- containing a value small that the Heap's smallest -- value. Each itteration of loop moves up through -- the elements and loop will terminate when X is -- smaller than current element or when top of Heap -- is reached. H.Elements( I ) := H.Elements( I/2 ); I := I/2; end loop; -- Asseration: new element placed above elements of lower value
-- store new element H.Elements( I ) := X; end Insert;
-- ======================================================================
procedure Delete_Min( Min : out Element_Type; H : in out Priority_Queue ) is
Child : Integer := 1; I : Integer := 1; Last_Element : Element_Type := H.Elements( H.Size );
begin -- Delete_Min if Is_Empty( H ) then raise Underflow; end if; Min := H.Elements( 1 ); H.Size := H.Size - 1; loop -- Inveriant: Heap contains a finite number of elements. Starting -- with the last element in Heap, each pass thru loop -- results in moving pointer Child closer to -- top of Heap. Loop will terminate when pointer Child -- reached top of Heap or when Last_Element is less then -- or equal to current Child. -- find smaller child. Child := I * 2; exit when Child > H.Size; if Child /= H.Size and then H.Elements( Child ) > H.Elements( Child + 1 ) then Child := Child + 1; end if; -- push down one level if needed. exit when H.Elements( Child ) > Last_Element; H.Elements( I ) := H.Elements( Child ); I := Child; end loop; -- Asseration: Element at top of heap is deleted and returned to -- caller. Size of Heap is reduced by one. Smallest -- remaining element is promoted to top of heap. H.Elements( I ) := Last_Element; end Delete_Min;
-- ======================================================================
function Find_Min( H : Priority_Queue ) return Element_Type is
anElem : Element_Type;
begin -- Find_Min if Is_Empty( H ) then raise Underflow; end if; return H.Elements( 1 ); end Find_Min;
-- ======================================================================
function Is_Empty( H : Priority_Queue ) return boolean is
begin -- Is_Empty return H.Size = 0; end Is_Empty;
-- ======================================================================
function Is_Full( H : Priority_Queue ) return boolean is
begin -- Is_Full return H.Size = H.Elements'Last; end Is_Full;
-- ======================================================================
procedure Build_Heap( Num : in natural; -- # of elements for heap Raw_Data : in Array_of_Element_Type; -- raw data H : out Priority_Queue) is
A : Priority_Queue( Num ); -- Procedure: Perc_Down -- Precondition: array of elements, pointer to an element -- Postcondition: element is reqositioned to be below elements -- of higher value.
procedure Perc_Down( A : in out Priority_Queue; I : in natural ) is Current_Node : natural := I ; Tmp : Element_Type := A.Elements( Current_Node ); Child : natural;
begin -- Perc_Down loop -- Invariant: each loop iteration looks at the two child nodes -- of node to be pushed down ... loop terminates if -- node to be pushed is leaf node ... loop terminates -- if node to be pushed is less than both of the -- leaves ... else bubble moves down to smallest leaf -- find a larger child if not at a leaf Child := Current_Node * 2; exit when Child > A.Elements'Last; if Child /= A.Elements'Last and then A.Elements( Child ) > A.Elements( Child + 1 ) then Child := Child + 1; end if; -- push bubble down if needed exit when A.Elements( Child ) > Tmp; A.Elements( Current_Node ) := A.Elements( Child ); Current_Node := Child; end loop; -- Asseration: Current Node is pushed down is binary heap tree -- until it finds it correct level ... as a child to -- a larger parrent. A.Elements( Current_Node ) := Tmp; end Perc_Down; begin -- Build_Heap -- make a heap, copy raw data to it Make_Null( A ); A.Elements( 1 .. Num ) := Raw_Data( 1 .. Num ); A.Size := Num; -- Perculate Down larger size nodes for I in reverse 1 .. ( Num / 2 ) loop Perc_Down( A, I ); end loop; -- finished H.Elements( 0 .. Num ) := A.Elements( 0 .. Num ); H.Size := A.Size; end Build_Heap;
-- ======================================================================
procedure Print_Heap( H : in Priority_Queue) is
MaxNodes : natural := 1; Depth : natural := 0; -- Procedure: Print_a_Chile, recursive routine to print heap -- Precondigion: valid heap, element I to print, offset D -- Postcondition: none procedure Print_a_Child( I : in natural; D : in natural ) is J : natural; begin -- right child index equals Node index * 2 + 1 J := I * 2 + 1; -- is right child index greater than maximum # of nodes if J <= MaxNodes then Print_a_Child( J, D + 1 ); end if; -- print head node if it exists if I <= H.Size then Set_Col( To => ( Positive_Count( ( (D) * 13 ) + 1) ) ); put( H.Elements( I ) ); end if; New_Line; -- left child index equals Node index * 2 J := J -1; -- is right child index greater than maximum # of nodes if J <= MaxNodes then Print_a_Child( J, D + 1 ); end if; end Print_a_Child; begin -- Print_Heap if Is_Empty( H ) then raise Underflow; else -- calculate size and height of heap while MaxNodes <= H.Size loop -- Inveriant: each loop iteration increases MaxNodes untill -- it exceeds size of this heap Depth := Depth + 1; MaxNodes := MaxNodes * 2; end loop; -- Asseration: maximum # of Nodes for Heap of this size -- and Depth of this Heap MaxNodes := MaxNodes - 1; -- print the heap Print_a_Child ( 1, 0 ); end if; end Print_Heap;
-- ======================================================================
end Binary_Heap_Pack;
-- ======================================================================