home *** CD-ROM | disk | FTP | other *** search
/ Chip 1995 March / CHIP3.mdf / programm / prog4 / btree.ada < prev    next >
Encoding:
Text File  |  1991-07-01  |  4.5 KB  |  157 lines
  1.                                        -- Chapter 23 - Program 3
  2. with Text_IO, Unchecked_Deallocation;
  3. use Text_IO;
  4.  
  5. procedure BTree is
  6.  
  7.    package Int_IO is new Text_IO.Integer_IO(INTEGER);
  8.    use Int_IO;
  9.  
  10.    Test_String : constant STRING := "DBCGIF";
  11.    Data_String : constant STRING := "This tests ADA";
  12.  
  13.    type B_TREE_NODE;                 -- Incomplete declaration
  14.  
  15.    type NODE_POINT is access B_TREE_NODE;
  16.  
  17.    type B_TREE_NODE is               -- Complete declaration
  18.       record
  19.          One_Letter : CHARACTER;
  20.          Left       : NODE_POINT;
  21.          Right      : NODE_POINT;
  22.       end record;
  23.  
  24.    pragma CONTROLLED(NODE_POINT);
  25.  
  26.    procedure Free is new Unchecked_Deallocation(B_TREE_NODE,
  27.                                                       NODE_POINT);
  28.  
  29.    Root  : NODE_POINT;    -- Always points to the root of the tree
  30.  
  31.    procedure Traverse_List(Start_Node : NODE_POINT) is
  32.    begin
  33.       if Start_Node.Left /= null then
  34.          Traverse_List(Start_Node.Left);
  35.       end if;
  36.       Put(Start_Node.One_Letter);
  37.       if Start_Node.Right /= null then
  38.          Traverse_List(Start_Node.Right);
  39.       end if;
  40.    end Traverse_List;
  41.  
  42.    procedure Store_Character(In_Char : CHARACTER) is
  43.    Temp : NODE_POINT;
  44.  
  45.       procedure Locate_And_Store(Begin_Node : in out NODE_POINT) is
  46.       begin
  47.          if In_Char < Begin_Node.One_Letter then
  48.             if Begin_Node.Left = null then
  49.                Begin_Node.Left := Temp;
  50.             else
  51.                Locate_And_Store(Begin_Node.Left);
  52.             end if;
  53.          else
  54.             if Begin_Node.Right = null then
  55.                Begin_Node.Right := Temp;
  56.             else
  57.                Locate_And_Store(Begin_Node.Right);
  58.             end if;
  59.          end if;
  60.       end Locate_And_Store;
  61.  
  62.    begin
  63.       Temp := new B_TREE_NODE;
  64.          Temp.One_Letter := In_Char; -- New record is now defined
  65.                                      -- The system sets Next_Rec
  66.                                      -- to the value of null
  67.       if Root = null then
  68.          Root := Temp;
  69.       else
  70.          Locate_And_Store(Root);
  71.       end if;
  72.       Put("Ready to traverse list. --->");
  73.       Traverse_List(Root);
  74.       New_Line;
  75.    end Store_Character;
  76.  
  77. begin
  78.             -- Store the characters in Data_String in a Binary Tree
  79.    for Index in Data_String'RANGE loop
  80.       Store_Character(Data_String(Index));
  81.    end loop;
  82.  
  83.             -- Traverse the list
  84.    New_Line;
  85.    Put_Line("Now for the final traversal of Data_String.");
  86.    Put("Ready to traverse list. --->");
  87.    Traverse_List(Root);
  88.    New_Line(2);
  89.  
  90.    Root := null;    -- Needed to clear out the last tree
  91.  
  92.             -- Store the characters in Test_String in a Binary Tree
  93.    for Index in Test_String'RANGE loop
  94.       Store_Character(Test_String(Index));
  95.    end loop;
  96.  
  97.             -- Traverse the list
  98.    New_Line;
  99.    Put_Line("Now for the final traversal of Test_String.");
  100.    Put("Ready to traverse list. --->");
  101.    Traverse_List(Root);
  102.    New_Line;
  103.  
  104.             -- Now deallocate the tree
  105.    declare
  106.       procedure Free_Up(Current_Node : in out NODE_POINT) is
  107.       begin
  108.          if Current_Node.Left /= null then
  109.             Free_Up(Current_Node.Left);
  110.          end if;
  111.          if Current_Node.Right /= null then
  112.             Free_Up(Current_Node.Right);
  113.          end if;
  114.          Free(Current_Node);
  115.       end Free_Up;
  116.    begin
  117.       if Root /= null then
  118.          Free_Up(Root);
  119.       end if;
  120.    end;
  121.  
  122. end BTree;
  123.  
  124.  
  125.  
  126.  
  127. -- Result of execution
  128. --
  129. -- Ready to traverse list. --->T
  130. -- Ready to traverse list. --->Th
  131. -- Ready to traverse list. --->Thi
  132. -- Ready to traverse list. --->This
  133. -- Ready to traverse list. ---> This
  134. -- Ready to traverse list. ---> Thist
  135. -- Ready to traverse list. ---> Tehist
  136. -- Ready to traverse list. ---> Tehisst
  137. -- Ready to traverse list. ---> Tehisstt
  138. -- Ready to traverse list. ---> Tehissstt
  139. -- Ready to traverse list. --->  Tehissstt
  140. -- Ready to traverse list. --->  ATehissstt
  141. -- Ready to traverse list. --->  ADTehissstt
  142. -- Ready to traverse list. --->  AADTehissstt
  143. --
  144. -- Now for the final traversal of Data_String.
  145. -- Ready to traverse list. --->  AADTehissstt
  146.  
  147. -- Ready to traverse list. --->D
  148. -- Ready to traverse list. --->BD
  149. -- Ready to traverse list. --->BCD
  150. -- Ready to traverse list. --->BCDG
  151. -- Ready to traverse list. --->BCDGI
  152. -- Ready to traverse list. --->BCDFGI
  153.  
  154. -- Now for the final traversal of Test_String.
  155. -- Ready to traverse list. --->BCDFGI
  156.  
  157.