... this page is part of the Web Site of George North ...

Package: Avl_Tree_Pack declerations





-- Problem:  provied a generic AVL Tree ADT

-- by: George North -- Fall 1994 -- -- ======================================================================

generic type Element_Type is private; with function "<" (Left, Right : Element_Type) return boolean; with function ">" (Left, Right : Element_Type) return boolean; with procedure Put(element: Element_Type);

-- ======================================================================

package Avl_Tree_Pack is

type Avl_Ptr is private; type Search_Tree is limited private;

-- ======================================================================

-- Procedure: Make_Null -- Precondition: valid AVL search tree -- Postcondition: one new node

procedure Make_Null ( T : in out Search_Tree );

-- ======================================================================

-- Function: Find -- Precondition: element to find, valid AVL search tree -- Postcondition: pointer to found node, raze exception if not found

function Find ( X : Element_Type; T : Search_Tree ) return Avl_Ptr;

-- ======================================================================

-- Function: Find_Min -- Precondition: valid AVL search tree -- Postcondition: pointer to smallest node in tree

function Find_Min ( T : Search_Tree ) return Avl_Ptr;

-- ======================================================================

-- Function: Find_Max -- Precondition: valid AVL search tree -- Postcondition: pointer to largest node in tree

function Find_Max ( T : Search_Tree ) return Avl_Ptr;

-- ======================================================================

-- Procedure: Insert -- Precondition: element to insert, valid AVL search tree -- Postcondition: exception if node already exists -- or new node added, tree balance intact

procedure Insert ( X : in Element_Type; T : in out Search_Tree );

-- ======================================================================

-- Procedure: Delete -- Precondition: element to delete, valid AVL search tree -- Postcondition: exception if node already exists -- or mark node as deleted, do NOT remove

procedure Delete ( X : in Element_Type; T : in out Search_Tree );

-- ======================================================================

-- Procedure: Print_Tree -- Precondition: valid AVL search tree -- Postcondition: none -- or mark node as deleted, do NOT remove

procedure Print_Tree ( T : in Search_Tree );

-- ======================================================================

-- Procedure: Print in Order -- Precondition: valid AVL search tree -- Postcondition: none -- or mark node as deleted, do NOT remove

procedure Print_in_Order ( T : in Search_Tree );

-- ======================================================================

-- Function: Retrieve -- Precondition: valid AVL search tree -- Postcondition: pointer to largest node in tree

function Retrieve ( P : Avl_Ptr ) return Element_Type;

-- ======================================================================

Item_Not_Found : exception;

-- ====================================================================== -- ======================================================================

private type Avl_Node; type Avl_Ptr is access Avl_Node; type Search_Tree is new Avl_Ptr;

type Avl_Node is record Element : Element_Type; Left : Search_Tree; Right : Search_Tree; Height : natural; Deleted : boolean; end record; end Avl_Tree_Pack;

-- ======================================================================

-- Package Body: Avl_Tree_Pack

-- Problem: provied a generic AVL Tree ADT -- ======================================================================

with Unchecked_Deallocation; with Text_IO; use Text_IO;

-- ======================================================================

package body Avl_Tree_Pack is

procedure Dispose is new Unchecked_Deallocation( Object => Avl_Node, Name => Avl_Ptr );

-- ======================================================================

-- Function : Height -- Precondition: valit AVL tree -- Postcondition: height of this tree as Integer -- or -1 is tree is null.

function Height ( T : Search_Tree ) return Integer is begin -- Height if T = null then return -1; else return T.Height; end if; end Height;

-- ======================================================================

-- Function: Max -- Precondition: two valid intergers -- Postcondition: largest integer function Max( H_L, H_R : integer ) return integer is

begin -- Max if H_L >= H_R then return H_L; else return H_R; end if; end Max;

-- ======================================================================

-- Procedure: S_Rotate_Left -- Precondition: valit AVL tree and a left child -- Postcondition: new root node procedure S_Rotate_Left ( T2 : in out Search_Tree ) is

T1 : Search_Tree := T2.Left;

begin -- S_Rotate_Left T2.Left := T1.Right; T1.Right := T2; -- calculate new height T2.Height := Max( Height( T2.Left ), Height( T2.Right ) ) + 1; T1.Height := Max( Height( T1.Left ), T2.Height ) + 1; -- new root T2 := T1; end S_Rotate_Left;

-- ======================================================================

-- Procedure: S_Rotate_Right -- Precondition: valit AVL tree and a right child -- Postcondition: new root node procedure S_Rotate_Right ( T2 : in out Search_Tree ) is

T1 : Search_Tree := T2.Right;

begin -- S_Rotate_Right T2.Right := T1.Left; T1.Left := T2; -- calculate new height T2.Height := Max( Height( T2.Right ), Height( T2.Left ) ) + 1; T1.Height := Max( Height( T1.Right ), T2.Height ) + 1; -- new root T2 := T1; end S_Rotate_Right;

-- ======================================================================

-- Procedure: D_Rotate_Left -- Precondition: valit AVL tree and a left child -- Postcondition: new root node procedure D_Rotate_Left ( T3 : in out Search_Tree ) is

begin -- D_Rotate_Left S_Rotate_Right( T3.Left ); S_Rotate_Left ( T3 ); end D_Rotate_Left;

-- ======================================================================

-- Procedure: D_Rotate_Right -- Precondition: valit AVL tree and a right child -- Postcondition: new root node procedure D_Rotate_Right ( T3 : in out Search_Tree ) is

begin -- D_Rotate_Right S_Rotate_Left ( T3.Right ); S_Rotate_Right( T3 ); end D_Rotate_Right;

-- ======================================================================

procedure Make_Null ( T : in out Search_Tree ) is begin -- Make_Null T := null; end Make_Null;

-- ======================================================================

function Find ( X : Element_Type; T : Search_Tree ) return Avl_Ptr is begin -- Find if T = null then raise Item_Not_Found; elsif X < T.Element then return Find( X, T.Left ); elsif X > T.Element then return Find( X, T.Right ); else if T.Deleted then raise Item_Not_Found; else return Avl_Ptr( T ); end if; end if; end Find;

-- ======================================================================

function Find_Min ( T : Search_Tree ) return Avl_Ptr is begin -- Find_Min if T = null then raise Item_Not_Found; elsif T.Left = null then return Avl_Ptr( T ); else return Find_Min( T.Left ); end if; end Find_Min;

-- ======================================================================

function Find_Max ( T : Search_Tree ) return Avl_Ptr is begin -- Find_Max if T = null then raise Item_Not_Found; elsif T.Right = null then return Avl_Ptr( T ); else return Find_Max( T.Right ); end if; end Find_Max;

-- ======================================================================

procedure Insert( X : in Element_Type; T : in out Search_Tree ) is

-- Procedure: Calculate_Height -- Precondition: valid tree -- Postcondition: height of tree procedure Calculate_Height( T: in out Search_Tree ) is

begin -- Calculate_Height T.Height := Max( Height( T.Left ), Height( T.Right ) ) + 1; end Calculate_Height;

begin -- Insert if T = null then -- Create a one node avl tree. T := new Avl_Node'( X, null, null, 0, FALSE ); elsif X < T.Element then Insert( X, T.Left ); if Height( T.Left ) - Height( T.Right ) = 2 then if X < T.Left.Element then S_Rotate_Left( T ); else D_Rotate_Left( T ); end if; else Calculate_Height( T ); end if; elsif X > T.Element then Insert( X, T.Right ); if Height( T.Left ) - Height( T.Right ) = -2 then if X > T.Right.Element then S_Rotate_Right( T ); else D_Rotate_Right( T ); end if; else Calculate_Height( T ); end if; else -- x is in the avl already. if T.Deleted then T.Deleted := FALSE; end if; end if; end Insert;

-- ======================================================================

procedure Delete ( X : in Element_Type; T : in out Search_Tree ) is begin -- Delete if T = null then raise Item_Not_Found; elsif X < T.Element then Delete( X, T.Left ); elsif X > T.Element then Delete( X, T.Right ); else if T.Deleted then raise Item_Not_Found; else T.Deleted := TRUE; end if; end if; end Delete;

-- ======================================================================

procedure Print_Tree ( T : in Search_Tree ) is

procedure Print_T ( T : in Search_Tree; Depth : in Natural ) is

procedure Print_Tree_Node ( D : in Natural; T : in Search_Tree ) is begin -- Print_Tree_Node Set_Col( To => ( Positive_Count( ( D * 4 ) + 1) ) ); put( T.Element ); if T.Deleted then put( " - Deleted" ); end if; New_Line; end Print_Tree_Node;

begin -- Print_T if T /= null then Print_Tree_Node( Depth, T ); Print_T( T.Left, Depth + 1 ); Print_T( T.Right, Depth + 1 ); end if; end Print_T;

begin -- Print_Tree Print_T( T, 0); end Print_Tree;

-- ======================================================================

procedure Print_in_Order ( T : in Search_Tree ) is begin -- Print_in_Order if T /= null then Print_in_Order( T.Left ); if T.Deleted then New_Line; else put( T.Element ); New_Line; end if; Print_in_Order( T.Right ); end if; end Print_in_Order;

-- ======================================================================

function Retrieve ( P : Avl_Ptr ) return Element_Type is

T : Element_Type := P.Element;

begin -- Retrieve return T; end Retrieve;

-- ====================================================================== -- ======================================================================

end Avl_Tree_Pack;

Airline_Info

Airline_Info a driver program for Avl_Tree_Pack
with Text_IO; use Text_IO; with My_Int_IO; use My_Int_IO; with My_Flt_IO; use My_Flt_IO; with Avl_Tree_Pack; with String_Handler;

-- ======================================================================

-- Program: Airline_Info

-- Problem: Provide Airline flight information

-- ======================================================================

procedure Airline_Info is

-- variable used to redirect console input (FOR TESTING ONLY) sampleData : Text_IO.File_Type;

-- define a record for Airline information Carrier_Max : Integer := 5; subtype Carrier_Type is string( 1 .. Carrier_Max );

type Flight_Record is record Flight_Number : Natural; Carrier : Carrier_Type; Ticket_Price : Float; end record;

theFlight : Flight_Record; theFlight_Number : Natural; theCarrier : Carrier_Type; theTicket_Price : Float; Event_Max : Integer := 1; subtype Event_Type is string( 1 .. Event_Max ); theEvent : Event_Type;

-- instanciate an Avl_Tree ADT from generic

function Flight_Less( A : in Flight_Record; B : in Flight_Record ) return boolean; function Flight_Greater( A : in Flight_Record; B : in Flight_Record ) return boolean; procedure Put_Flight( R : in Flight_Record);

package Flight_Avl_ADT is new Avl_Tree_Pack( Element_Type => Flight_Record, "<" => Flight_Less, ">" => Flight_Greater, Put => Put_Flight ); use Flight_Avl_ADT;

Flight_Reservations_Tree : Search_Tree;

-- ======================================================================

-- Function : Flight_Less, used for "<" in generic package -- Precondition : valid Flight Records -- Postcondition : boolean, true if less than

function Flight_Less( A : in Flight_Record; B : in Flight_Record ) return boolean is begin -- Flight_Less return A.Flight_Number < B.Flight_Number; end Flight_Less;

-- ======================================================================

-- Function : Flight_Greater, used for ">" in generic package -- Precondition : valid Flight Records -- Postcondition : boolean, true if greater than

function Flight_Greater( A : in Flight_Record; B : in Flight_Record ) return boolean is begin -- Flight_Greater return A.Flight_Number > B.Flight_Number; end Flight_Greater;

-- ======================================================================

-- Procedure : Put_Flight, used for "put" in generic package -- Precondition : valid Flight Records -- Postcondition : none

procedure Put_Flight( R : in Flight_Record) is begin -- Put_Flight put( R.Flight_Number, 1 ); put( " (" ); put( String_Handler.Without_Trailing_Blanks( R.Carrier ) ); put( ", " ); put( R.Ticket_Price, 1, 1, 0 ); put( ")" ); end Put_Flight;

-- ======================================================================

-- Procedure : Get_Flight_Input -- Precondition : none -- Postcondition : put one character to Console

procedure Get_Flight_Input( aEvent : out Event_Type ; aFlight_Number : out Natural ; aCarrier : out Carrier_Type; aTicket_Price : out Float ) is Event : Event_Type; Flight_Number : Natural; Carrier : Carrier_Type; Ticket_Price : Float; begin -- Get_Flight_Input loop -- Inveriant: data input control loop, will terminate -- 1. when one valid line of data is read -- 2. end of file is reached. begin -- input block get( Event ); -- put( Event ); aEvent := Event; if Event = "P" then Skip_Line; exit; end if; get( Flight_Number ); -- put( " " ); -- put( Flight_Number, 1 ); aFlight_Number := Flight_Number; if Event = "Q" or Event = "D" then Skip_Line; exit; end if; if Event = "S" then get( Carrier ); -- put( " " ); -- put(String_Handler.Without_Trailing_Blanks( Carrier )); aCarrier := Carrier; get( Ticket_Price ); -- put( " " ); -- put( Ticket_Price, 1, 1, 0 ); aTicket_Price := Ticket_Price; -- New_Line; exit; end if; put( ", INVALID INPUT, skipped." ); New_Line; exception when End_Error => exit; when Others => put( "Invalid input, skipped" ); end; -- input block end loop; -- Asseration: one valid line of data input end Get_Flight_Input;

-- ======================================================================

-- Procedure : Delete_a_Flight -- Precondition : valid Flight record -- Postcondition : none

procedure Delete_a_Flight( aFlight : in Flight_Record) is begin -- Delete_a_Flight Delete( theFlight, Flight_Reservations_Tree ); exception when Item_Not_Found => put (aFlight.Flight_Number ); put ( " not found, when attempting to DELETE." ); New_Line; end Delete_a_Flight;

-- ====================================================================== -- Procedure : Print_a_Flight -- Precondition : valid Flight record -- Postcondition : none

procedure Print_a_Flight( aFlight : in Flight_Record) is begin -- Print_a_Flight theFlight := Retrieve( Find( theFlight, Flight_Reservations_Tree ) ); Put_Flight( theFlight ); New_Line; exception when Item_Not_Found => put (aFlight.Flight_Number ); put ( " not found." ); New_Line; end Print_a_Flight;

-- ====================================================================== -- ======================================================================

begin -- Airline_Info

-- Open sample data file, for testing ONLY -- Text_IO.Open( File => sampleData, Mode => Text_IO.In_File, -- Name => "Prog8_Sample.dat" ); -- Text_IO.Set_Input( File => sampleData );

Make_Null( Flight_Reservations_Tree );

while Not End_of_File loop -- Inveriant: loop will terminate when end of file is reached Get_Flight_Input( theEvent, theFlight_Number, theCarrier, theTicket_Price ); theFlight.Flight_Number := theFlight_Number; theFlight.Carrier := theCarrier; theFlight.Ticket_Price := theTicket_Price; if theEvent = "P" then Print_Tree( Flight_Reservations_Tree ); New_Line; -- this is a good put( "Queriers: "); -- example of bad New_Line; -- coding ..."Queriers" elsif theEvent = "S" then Insert( theFlight, Flight_Reservations_Tree ); elsif theEvent = "D" then Delete_a_Flight( theFlight ); elsif theEvent = "Q" then Print_a_Flight( theFlight ); end if; end loop; -- Asseriation: all input data has been processed, -- and one valid avl tree exists ... New_Line ( 2 ); Put( "Final avl Tree:" ); New_Line; Print_Tree( Flight_Reservations_Tree ); New_Line ( 2 ); Put( "Final avl Tree, print in order:" ); New_Line; Print_in_Order ( Flight_Reservations_Tree ); end Airline_Info;


Converted with HTML Markup 1.1 by Scott J. Kleper
http://htc.rit.edu/klephacks/markup.html
ftp://htc.rit.edu/pub/HTML-Markup-current.hqx