home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 13 / CDA13.ISO / cdactual / demobin / share / program / Pascal / BFTGPH.ZIP / TREE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-09-09  |  10.1 KB  |  255 lines

  1. Unit Tree;
  2.  
  3. (***************************************************************************)
  4. (*   Unit Name: Tree                                                       *)
  5. (*                                                                         *)
  6. (*   Description:   This unit implements a tree based data structure using *)
  7. (*   pointers to connect the nodes.  Each node of the tree consists of     *)
  8. (*   pointers to its parent, brother, and son.  In addition each node      *)
  9. (*   contains a label field.  The following functions are used and         *)
  10. (*   documented:                                                           *)
  11. (*                   NewTree : tree                                        *)
  12. (*                   AddTreeNode(node,label)                               *)
  13. (*                   DeleteTreeNode(node)                                  *)
  14. (*                   Parent(node):node                                     *)
  15. (*                   FirstChild(node):node                                 *)
  16. (*                   NextSibling(node):node                                *)
  17. (*                   PrintTree(tree)                                       *)
  18. (*                                                                         *)
  19. (***************************************************************************)
  20.  
  21. Interface
  22.  
  23. type TreeNode = ^TreePointer;
  24.      TreePointer = record
  25.            Name: char;
  26.            Parent,
  27.            Brother,
  28.            Son: TreeNode;
  29.         end;
  30.  
  31.  
  32. Function NewTree( Name : char ) : TreeNode;
  33. Function Root( Tree : TreeNode ) : TreeNode;
  34. Function Parent( Node: TreeNode ) : TreeNode;
  35. Function NextSibling( Node: TreeNode ) : TreeNode;
  36. Function FirstChild( Node: TreeNode ) : TreeNode;
  37. Procedure AddTreeNode( Node: TreeNode; Name: char );
  38. Procedure DeleteTreeNode( Node: TreeNode );
  39. Procedure PrintTree( Tree : TreeNode );
  40.  
  41.  
  42. Implementation
  43.  
  44. (***************************************************************************)
  45. (*    Name: NewTree                                                        *)
  46. (*                                                                         *)
  47. (*    Purpose:  This function creates a new empty tree                     *)
  48. (*    Input:   None                                                        *)
  49. (*    Ouput:   Pointer to new tree                                         *)
  50. (***************************************************************************)
  51.  
  52. Function NewTree( Name : char ) : TreeNode;
  53.  
  54. var Root : TreeNode;
  55.  
  56. begin
  57.    New(root);
  58.    Root^.Name := Name;
  59.    Root^.Parent := nil;
  60.    Root^.Brother := nil;
  61.    Root^.Son := nil;
  62.    NewTree := Root
  63. end;
  64.  
  65.  
  66.  
  67. (***************************************************************************)
  68. (*   Name: Root                                                            *)
  69. (*                                                                         *)
  70. (*   Purpose: Returns the root of the given tree                           *)
  71. (*   Input: Tree - pointer of the first node of tree                       *)
  72. (*   Output: pointer to the first nodee of the tree (I.E. the root)        *)
  73. (***************************************************************************)
  74.  
  75. Function Root( Tree : TreeNode ) : TreeNode;
  76.  
  77. begin
  78.    Root := Tree;
  79. end;
  80.  
  81.  
  82.  
  83. (***************************************************************************)
  84. (*   Name: AddTreeNode                                                     *)
  85. (*                                                                         *)
  86. (*   Purpose: This function creates a new tree node with the given value   *)
  87. (*            as a son of the given node                                   *)
  88. (*   Input: Parent of node to be inserted                                  *)
  89. (*          Value for new node                                             *)
  90. (*   Output: Pointer to the new node                                       *)
  91. (***************************************************************************)
  92.  
  93. Procedure AddTreeNode( Node: TreeNode; Name: char );
  94.  
  95. var NewNode: TreeNode;
  96.  
  97. begin
  98.    if Node <> nil
  99.       then begin
  100.               New(NewNode);
  101.               NewNode^.Name := Name;
  102.               NewNode^.Parent := Node;
  103.               NewNode^.Brother := nil;
  104.               NewNode^.Son := nil;
  105.               if Node^.Son <> nil
  106.                  then begin
  107.                          Node := Node^.Son;
  108.                          while Node^.Brother <> nil do
  109.                             Node := Node^.Brother;
  110.                          Node^.Brother := NewNode
  111.                       end
  112.                  else Node^.Son := NewNode
  113.            end
  114.       else writeln('AddTreeNode Error --- Given node does not exist ---');
  115. end;
  116.  
  117.  
  118.  
  119. (***************************************************************************)
  120. (*   Name: Parent                                                          *)
  121. (*                                                                         *)
  122. (*   Purpose: Returns the parent of the given node if it exists otherwise  *)
  123. (*            it returns a nil pointer.                                    *)
  124. (*   Input: Pointer to given node                                          *)
  125. (*   Output: Pointer to parent of given node                               *)
  126. (***************************************************************************)
  127.  
  128. Function Parent( Node: TreeNode ) : TreeNode;
  129.  
  130. begin
  131.    Parent := Node^.Parent
  132. end;
  133.  
  134.  
  135.  
  136. (***************************************************************************)
  137. (*   Name: FirstChild                                                      *)
  138. (*                                                                         *)
  139. (*   Purpose: Returns pointer to left most child of given node if it       *)
  140. (*            exists otherwise returns nil                                 *)
  141. (*   Input: Pointer to given node                                          *)
  142. (*   Output: Pointer to firstchild of given node                           *)
  143. (***************************************************************************)
  144.  
  145. Function FirstChild( Node: TreeNode ) : TreeNode;
  146.  
  147. begin
  148.    FirstChild := Node^.Son
  149. end;
  150.  
  151.  
  152.  
  153. (***************************************************************************)
  154. (*   Name: NextSibling                                                     *)
  155. (*                                                                         *)
  156. (*   Purpose: Returns pointer to the first sibling of the given node if it *)
  157. (*            otherwise it returns nil                                     *)
  158. (*   Input: Pointer to given node                                          *)
  159. (*   Output: Pointer to first sibling                                      *)
  160. (***************************************************************************)
  161.  
  162. Function NextSibling( Node: TreeNode ) : TreeNode;
  163.  
  164. begin
  165.    NextSibling := Node^.Brother
  166. end;
  167.  
  168.  
  169.  
  170. (***************************************************************************)
  171. (*   Name: DeleteTreeNode                                                  *)
  172. (*                                                                         *)
  173. (*   Purpose: Removes a leaf node from the tree                            *)
  174. (*   Input: Pointer to node to be deleted                                  *)
  175. (*   Output: None                                                          *)
  176. (***************************************************************************)
  177.  
  178. Procedure DeleteTreeNode( Node: TreeNode );
  179.  
  180. var N,M: TreeNode;
  181.  
  182. begin
  183.    if Node <> nil
  184.       then if Node^.Son = nil
  185.               then begin
  186.                       N := Node^.Parent;
  187.                       if N^.Son = Node
  188.                          then if Node^.Brother = nil
  189.                                 then N^.Son := nil
  190.                                 else N^.Son := Node^.Brother
  191.                          else begin
  192.                                  N := N^.Son;
  193.                                  while N^.Brother <> Node do
  194.                                     N := N^.Brother;
  195.                                  M := N^.Brother;
  196.                                  N^.Brother := M^.Brother
  197.                               end
  198.                    end
  199. end;
  200.  
  201.  
  202.  
  203.  
  204. (***************************************************************************)
  205. (*   Name: PrintTree                                                       *)
  206. (*                                                                         *)
  207. (*   Purpose:  To print a preorder traversal of the given tree             *)
  208. (*   Uses: Level - depth in tree                                               *)
  209. (*   Input: Pointer to root of tree                                        *)
  210. (*   Output: Printout of tree in preorder                                  *)
  211. (***************************************************************************)
  212.  
  213. Procedure PrintTree( Tree : TreeNode );
  214.  
  215. var Level: integer;
  216.  
  217.  
  218.  
  219.    (************************************************************************)
  220.    (*   Name: Traverse                                                     *)
  221.    (*                                                                      *)
  222.    (*   Purpose: a recursive procedure that prints the tree in preorder    *)
  223.    (*   Input: Level - how far to indent data output                       *)
  224.    (*          Node - Node to traverse                                     *)
  225.    (*   Output: Node data                                                  *)
  226.    (************************************************************************)
  227.  
  228.    Procedure Traverse( Node : TreeNode; var Level : integer );
  229.  
  230.    var Loop : integer;
  231.  
  232.    begin
  233.       if Node <> nil
  234.          then with Node^ do
  235.                  begin
  236.                     for Loop := 1 to Level do
  237.                         write('  ');
  238.                     writeln( Name );
  239.                     inc( Level );
  240.                     Traverse( Son,Level );
  241.                     dec( Level );
  242.                     Traverse( Brother,Level );
  243.                  end
  244.    end;
  245.  
  246. begin
  247.    Level := 0;
  248.    writeln('      Level');
  249.    writeln('0 1 2 3 4 5 6 7 8');
  250.    writeln('─────────────────');
  251.    Traverse( Tree,Level )
  252. end;
  253.  
  254. end.
  255.