Jan 11 15:50 1996 search_tree_package.ads Page 1 -- Generic Package Specification for Search_Tree_Package -- -- Requires: -- Instantiated with any private type and -- a "<" function for that type and -- a Put procedure for that type -- Types defined: -- Tree_Ptr private type -- Search_Tree limited private type -- Exceptions defined: -- Item_Not_Found raised when searches or deletions fail -- Operations defined: -- (* throws Item_Not_Found) -- Initialize and Finalize are defined for Search_Tree -- Delete * removes item from search tree -- Find * returns Tree_Ptr of item in search tree -- Find_Max * returns Tree_Ptr of maximum item in search tree -- Find_Min * returns Tree_Ptr of minimum item in search tree -- Insert insert item into search tree -- Make_Empty make a search tree empty -- Print_Tree print tree in sorted order -- Retrieve * returns item in Tree_Ptr passed as parameter with Ada.Finalization; with Text_IO; use Text_IO; generic type Element_Type is private; with function "<" ( Left, Right: Element_Type ) return Boolean; with procedure Put( Element: Element_Type ); package Search_Tree_Package is type Tree_Ptr is private; type Search_Tree is new Ada.Finalization.Limited_Controlled with private; procedure Initialize( T: in out Search_Tree ); procedure Finalize( T: in out Search_Tree ); procedure Delete( X: Element_Type; T: in out Search_Tree ); function Find( X: Element_Type; T: Search_Tree ) return Tree_Ptr; function Find_Min( T: Search_Tree ) return Tree_Ptr; function Find_Max( T: Search_Tree ) return Tree_Ptr; procedure Insert( X: Element_Type; T: in out Search_Tree ); procedure Make_Empty( T: in out Search_Tree ); procedure Print_Tree( T: Search_Tree ); function Retrieve( P: Tree_Ptr ) return Element_Type; Item_Not_Found : exception; private type Tree_Node; type Tree_Ptr is access Tree_Node; type Search_Tree is new Ada.Finalization.Limited_Controlled with record Root : Tree_Ptr; end record; Jan 11 15:50 1996 search_tree_package.ads Page 2 type Tree_Node is record Element : Element_Type; Left : Tree_Ptr; Right : Tree_Ptr; end record; -- This function is provided for illustrative purposes function Height( T: Search_Tree ) return Integer; end Search_Tree_Package; Jan 11 15:51 1996 search_tree_package.adb Page 1 -- Implementation of Search_Tree_Package with Unchecked_Deallocation; package body Search_Tree_Package is procedure Dispose is new Unchecked_Deallocation( Tree_Node, Tree_Ptr ); procedure Initialize( T: in out Search_Tree ) is begin null; end Initialize; procedure Finalize( T: in out Search_Tree ) is begin Make_Empty( T ); end Finalize; -- Internal routines that are implemented below function ">"( A, B: Element_Type ) return Boolean; function Max( A, B: Integer ) return Integer; function Find_Min( T: Tree_Ptr ) return Tree_Ptr; -- THE VISIBLE ROUTINES -- Procedure Delete removes X from Search_Tree T -- It calls the hidden recursive routine -- Raises Item_Not_Found if necessary procedure Delete( X: Element_Type; T: in out Search_Tree ) is procedure Delete( X: Element_Type; T: in out Tree_Ptr ) is Tmp_Cell : Tree_Ptr; begin if T = null then raise Item_Not_Found; end if; if X < T.Element then -- Go left Delete( X, T.Left ); elsif X > T.Element then -- Go right Delete( X, T.Right ); else -- Found the element to be deleted if T.Left = null then -- Only a right child Tmp_Cell := T; T := T.Right; Dispose( Tmp_Cell ); elsif T.Right = null then -- Only a left child Tmp_Cell := T; T := T.Left; Dispose( Tmp_Cell ); else -- 2 Children; Replace with smallest in right subtree Tmp_Cell := Find_Min( T.Right ); T.Element := Tmp_Cell.Element; Delete( T.Element, T.Right ); end if; end if; Jan 11 15:51 1996 search_tree_package.adb Page 2 end Delete; begin Delete( X, T.Root ); end Delete; -- Return Tree_Ptr of item X in tree T -- Calls hidden recursive routine -- Raises Item_Not_Found if necessary function Find( X: Element_Type; T: Search_Tree ) return Tree_Ptr is function Find( X: Element_Type; T: Tree_Ptr ) return Tree_Ptr is begin 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 return T; end if; end Find; begin return Find( X, T.Root ); end Find; -- Return Tree_Ptr of maximum item in tree T -- Raise Item_Not_Found if tree is empty function Find_Max( T: Search_Tree ) return Tree_Ptr is Curr_Node : Tree_Ptr := T.Root; begin if Curr_Node /= null then while Curr_Node.Right /= null loop Curr_Node := Curr_Node.Right; end loop; return Curr_Node; end if; raise Item_Not_Found; end Find_Max; -- Return Tree_Ptr of minimum item in tree rooted at T -- Raise Item_Not_Found if tree is empty -- This is not a hidden routine because it is used by Delete -- Even so, it is not visible outside the package function Find_Min( T: Tree_Ptr ) return Tree_Ptr is begin if T = null then raise Item_Not_Found; elsif T.Left = null then return T; else return Find_Min( T.Left ); end if; end Find_Min; Jan 11 15:51 1996 search_tree_package.adb Page 3 -- Return Tree_Ptr of minimum item in tree rooted at T -- Raise Item_Not_Found if tree is empty -- Calls the recursive routine function Find_Min( T: Search_Tree ) return Tree_Ptr is begin return Find_Min( T.Root ); end Find_Min; -- Insert X into tree T -- Calls the hidden recursive routine procedure Insert( X: Element_Type; T: in out Search_Tree ) is procedure Insert( X: Element_Type; T: in out Tree_Ptr ) is begin if T = null then -- Create a one node tree T := new Tree_Node'( X, null, null ); elsif X < T.Element then Insert( X, T.Left ); elsif X > T.Element then Insert( X, T.Right ); -- Else X is in the tree already; do nothing end if; end Insert; begin Insert( X, T.Root ); end Insert; -- Make tree T empty, and dispose all nodes -- Calls the hidden recursive routine procedure Make_Empty( T: in out Search_Tree ) is procedure Make_Empty( T: in out Tree_Ptr ) is begin if T /= null then Make_Empty( T.Left ); Make_Empty( T.Right ); Dispose( T ); end if; end Make_Empty; begin Make_Empty( T.Root ); end Make_Empty; -- Print the search tree T in sorted order -- Calls the hidden recursive routine procedure Print_Tree( T: Search_Tree ) is procedure Print_Tree( T: Tree_Ptr ) is begin if T /= null then Print_Tree( T.Left ); Put( T.Element ); New_Line; Print_Tree( T.Right ); end if; end Print_Tree; begin Print_Tree( T.Root ); end Print_Tree; Jan 11 15:51 1996 search_tree_package.adb Page 4 -- Return item in node given by Tree_Ptr P -- Raise Item_Not_Found if P is null function Retrieve( P: Tree_Ptr ) return Element_Type is begin if P = null then raise Item_Not_Found; else return P.Element; end if; end Retrieve; -- Height returns the height of tree T -- It calls the hidden recursive routine function Height( T: Search_Tree ) return Integer is function Height( T: Tree_Ptr ) return Integer is begin if T = null then return -1; else return 1 + Max( Height( T.Left ), Height( T.Right ) ); end if; end Height; begin return Height( T.Root ); end Height; -- INTERNAL ROUTINES -- ">" to make tree code look nicer function ">"( A, B: Element_Type ) return Boolean is begin return B < A; end ">"; -- Max function returns the larger of A and B -- Used for function Height function Max( A, B: Integer ) return Integer is begin if B < A then return A; else return B; end if; end Max; end Search_Tree_Package; Dec 8 09:57 1995 search_tree_package_test.adb Page 1 -- Simple test routine for binary search trees with Search_Tree_Package; with Ada.Text_IO; use Ada.Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; -- Main procedure starts here procedure Search_Tree_Package_Test is procedure Put_Int( X: Integer ); -- Now we instantiate the search tree package package Int_Tree is new Search_Tree_Package( Integer, "<", Put_Int ); use Int_Tree; -- Rest of main continues here T : Search_Tree; J : Integer; P : Tree_Ptr; procedure Put_Int( X: Integer ) is begin Integer_Text_IO.Put( X ); end Put_Int; begin Make_Empty( T ); J := 0; while J < 10 loop Insert( J, T ); J := J + 3; end loop; J := 8; while J > 0 loop Insert( J, T ); J := J - 3; end loop; Put( "Min: " ); Put( Retrieve( Find_Min( T ) ) ); New_Line; Put( "Max: " ); Put( Retrieve( Find_Max( T ) ) ); New_Line; for I in 0..10 loop begin P := Find( I, T ); Put( I ); Put_Line( " Found." ); exception when Item_Not_Found => Put( I ); Put_Line( " Not found." ); end; end loop; Print_Tree( T ); Delete( 6, T ); Print_Tree( T ); Dec 8 09:57 1995 search_tree_package_test.adb Page 2 end Search_Tree_Package_Test; Jan 11 15:51 1996 search_avl.ads Page 1 -- Generic Package Specification for Search_AVL -- Maintains AVL trees -- Requires: -- Instantiated with any private type and -- a "<" function for that type and -- a Put procedure for that type -- Types defined: -- Avl_Ptr private type -- Search_Tree limited private type -- Exceptions defined: -- Item_Not_Found raised when searches or deletions fail -- Operations defined: -- (* throws Item_Not_Found) -- Initialize and Finalize are defined for Search_Tree -- Delete * removes item from search tree -- Find * returns Tree_Ptr of item in search tree -- Find_Max * returns Tree_Ptr of maximum item in search tree -- Find_Min * returns Tree_Ptr of minimum item in search tree -- Insert insert item into search tree -- Make_Empty make a search tree empty -- Print_Tree print tree in sorted order -- Retrieve * returns item in Tree_Ptr passed as parameter with Ada.Finalization; with Text_IO; use Text_IO; generic type Element_Type is private; with function "<" ( Left, Right: Element_Type ) return Boolean; with procedure Put( Element: Element_Type ); package Search_Avl is type Avl_Ptr is private; type Search_Tree is new Ada.Finalization.Limited_Controlled with private; procedure Initialize( T: in out Search_Tree ); procedure Finalize( T: in out Search_Tree ); procedure Delete( X: Element_Type; T: in out Search_Tree ); function Find( X: Element_Type; T: Search_Tree ) return Avl_Ptr; function Find_Max( T: Search_Tree ) return Avl_Ptr; function Find_Min( T: Search_Tree ) return Avl_Ptr; procedure Insert( X: Element_Type; T: in out Search_Tree ); procedure Make_Empty( T: in out Search_Tree ); procedure Print_Tree( T: Search_Tree ); function Retrieve( P: Avl_Ptr ) return Element_Type; -- Used for debugging; returns true if T is AVL function Check_Ht( T: Search_Tree ) return Boolean; Item_Not_Found : exception; private type Avl_Node; type Avl_Ptr is access Avl_Node; type Search_Tree is new Ada.Finalization.Limited_Controlled with Jan 11 15:51 1996 search_avl.ads Page 2 record Root : Avl_Ptr; end record; type Avl_Node is record Element : Element_Type; Left : Avl_Ptr; Right : Avl_Ptr; Height : Natural; end record; end Search_Avl; Jan 11 15:52 1996 search_avl.adb Page 1 -- Implementation of Search_Avl with Unchecked_Deallocation; package body Search_Avl is procedure Dispose is new Unchecked_Deallocation( Avl_Node, Avl_Ptr ); procedure Initialize( T: in out Search_Tree ) is begin null; end Initialize; procedure Finalize( T: in out Search_Tree ) is begin Make_Empty( T ); end Finalize; -- Declarations for internal routines function ">"( Left, Right: Element_Type ) return Boolean; function Max( A, B: Integer ) return Integer; function Height( P: Avl_Ptr ) return Integer; procedure S_Rotate_Left( K2: in out Avl_Ptr ); procedure S_Rotate_Right( K2: in out Avl_Ptr ); procedure D_Rotate_Left( K3: in out Avl_Ptr ); procedure D_Rotate_Right( K3: in out Avl_Ptr ); -- THE VISIBLE ROUTINES -- Procedure Delete removes X from AVL tree T -- It is unimplemented procedure Delete( X: Element_Type; T: in out Search_Tree ) is begin Put_Line( "Delete is not implemented" ); end Delete; -- Return Avl_Ptr of item X in AVL tree T -- Calls hidden recursive routine -- Raises Item_Not_Found if necessary -- Same as binary search tree implementation function Find( X: Element_Type; T: Search_Tree ) return Avl_Ptr is function Find( X: Element_Type; T: Avl_Ptr ) return Avl_Ptr is begin 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 return T; end if; end Find; begin return Find( X, T.Root ); end Find; Jan 11 15:52 1996 search_avl.adb Page 2 -- Return Avl_Ptr of maximum item in AVL tree T -- Raise Item_Not_Found if T is empty -- Same as binary search tree implementation function Find_Max( T: Search_Tree ) return Avl_Ptr is Curr_Node : Avl_Ptr := T.Root; begin if Curr_Node /= null then while Curr_Node.Right /= null loop Curr_Node := Curr_Node.Right; end loop; return Curr_Node; end if; raise Item_Not_Found; end Find_Max; -- Return Avl_Ptr of minimum item in AVL tree T -- Raise Item_Not_Found if T is empty -- Calls hidden recursive routine -- Otherwise, implementation is same as for binary search tree function Find_Min( T: Search_Tree ) return Avl_Ptr is function Find_Min( T: Avl_Ptr ) return Avl_Ptr is begin if T = null then raise Item_Not_Found; elsif T.Left = null then return T; else return Find_Min( T.Left ); end if; end Find_Min; begin return Find_Min( T.Root ); end Find_Min; -- Insert X into tree T -- Calls hidden recursive routine procedure Insert( X: Element_Type; T: in out Search_Tree ) is procedure Calculate_Height( T: in out Avl_Ptr ) is begin T.Height := Max( Height( T.Left ), Height( T.Right ) ) + 1; end Calculate_Height; procedure Insert( X: Element_Type; T: in out Avl_Ptr ) is begin if T = null then -- Create a one node avl tree T := new Avl_Node'( X, null, null, 0 ); 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 ); Jan 11 15:52 1996 search_avl.adb Page 3 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; do nothing end if; end Insert; begin Insert( X, T.Root ); end Insert; -- Make AVL tree T empty, and dispose all nodes -- Implementation is identical to binary search tree procedure Make_Empty( T: in out Search_Tree ) is procedure Make_Empty( T: in out Avl_Ptr ) is begin if T /= null then Make_Empty( T.Left ); Make_Empty( T.Right ); Dispose( T ); end if; end Make_Empty; begin Make_Empty( T.Root ); end Make_Empty; -- Print the AVL tree T in sorted order -- Same as binary search tree routine procedure Print_Tree( T: Search_Tree ) is procedure Print_Tree( T: Avl_Ptr ) is begin if T /= null then Print_Tree( T.Left ); Put( T.Element ); New_Line; Print_Tree( T.Right ); end if; end Print_Tree; begin Print_Tree( T.Root ); end; -- Return item in node given by Avl_Ptr P -- Raise Item_Not_Found if P is null -- Same implementation as in binary search tree function Retrieve( P: Avl_Ptr ) return Element_Type is Jan 11 15:52 1996 search_avl.adb Page 4 begin if P = null then raise Item_Not_Found; else return P.Element; end if; end Retrieve; -- Return true if heights recorded in the nodes of T -- satisfy the AVL tree structure property -- Calls hidden recursive routine function Check_Ht( T: Search_Tree ) return Boolean is function Check_Ht( T: Avl_Ptr ) return Boolean is Left_Ht, Right_Ht : Integer; begin if T = null then return True; end if; if Check_Ht( T.Left ) and then Check_Ht( T.Right ) then if T.Left = null and T.Right = null then return T.Height = 0; elsif T.Left = null then return T.Height = T.Right.Height + 1; elsif T.Right = null then return T.Height = T.Left.Height + 1; else return T.Height = Max( T.Left.Height, T.Right.Height ) + 1; end if; else return False; end if; end Check_Ht; begin return Check_Ht( T.Root ); end Check_Ht; -- INTERNAL ROUTINES -- ">" to make tree code look nicer function ">"( Left, Right: Element_Type ) return Boolean is begin return Right < Left; end ">"; -- Return the height of the tree rooted at node P -- Empty trees have height of -1, by definition function Height( P: Avl_Ptr ) return Integer is begin if P = null then return -1; else return P.Height; end if; end Height; Jan 11 15:52 1996 search_avl.adb Page 5 -- Max function returns the larger of A and B -- It is used for updating heights during rotations function Max( A, B: Integer ) return Integer is begin if B < A then return A; else return B; end if; end Max; -- This procedure can be called only if K2 has a left child -- Perform a rotate between a K2 and its left child -- Update heights -- Then assign the new root to K2 procedure S_Rotate_Left( K2: in out Avl_Ptr ) is K1 : Avl_Ptr := K2.Left; begin K2.Left := K1.Right; K1.Right := K2; K2.Height := Max( Height( K2.Left ), Height( K2.Right ) ) + 1; K1.Height := Max( Height( K1.Left ), K2.Height ) + 1; K2 := K1; -- Assign new root end S_Rotate_Left; -- Mirror image symmetry for S_Rotate_Left procedure S_Rotate_Right( K2: in out Avl_Ptr ) is K1 : Avl_Ptr; begin K1 := K2.Right; K2.Right := K1.Left; K1.Left := K2; K2.Height := Max( Height( K2.Right ), Height( K2.Left ) ) + 1; K1.Height := Max( Height( K1.Right ), K2.Height ) + 1; K2 := K1; -- Assign new root end S_Rotate_Right; -- This procedure can only be called if K3 has a left child -- and K3's left child has a right child -- Do the left-right double rotation and update heights procedure D_Rotate_Left( K3: in out Avl_Ptr ) is begin S_Rotate_Right( K3.Left ); -- Rotate between k1 and k2 S_Rotate_Left ( K3 ); -- Rotate between k3 and k2 end D_Rotate_Left; -- Mirror image symmetry of D_Rotate_Left procedure D_Rotate_Right( K3: in out Avl_Ptr ) is begin S_Rotate_Left( K3.Right ); -- Rotate between k1 and k2 S_Rotate_Right ( K3 ); -- Rotate between k3 and k2 end D_Rotate_Right; Jan 11 15:52 1996 search_avl.adb Page 6 end Search_Avl; Dec 8 09:58 1995 search_avl_test.adb Page 1 -- Quick test routine for AVL trees with Search_AVL; with Ada.Text_IO; use Ada.Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; -- Main procedure starts here procedure Search_AVL_Test is procedure Put_Int( X: Integer ); -- Now we instantiate the search tree package package Int_Tree is new Search_AVL( Integer, "<", Put_Int ); use Int_Tree; -- Rest of main continues here T : Search_Tree; J : Integer; P : AVL_Ptr; procedure Put_Int( X: Integer ) is begin Integer_Text_IO.Put( X ); end Put_Int; begin Make_Empty( T ); J := 0; while J < 10 loop Insert( J, T ); J := J + 3; end loop; J := 8; while J > 0 loop Insert( J, T ); J := J - 3; end loop; Put( "Min: " ); Put( Retrieve( Find_Min( T ) ) ); New_Line; Put( "Max: " ); Put( Retrieve( Find_Max( T ) ) ); New_Line; for I in 0..10 loop begin P := Find( I, T ); Put( I ); Put_Line( " Found." ); exception when Item_Not_Found => Put( I ); Put_Line( " Not found." ); end; end loop; Print_Tree( T ); Delete( 6, T ); Print_Tree( T ); Dec 8 09:58 1995 search_avl_test.adb Page 2 end Search_AVL_Test;