[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]

    Unit Tree; { see test program at the end !! }

    (***************************************************************************)
    (*   Unit Name: Tree                                                       *)
    (*                                                                         *)
    (*   Description:   This unit implements a tree based data structure using *)
    (*   pointers to connect the nodes.  Each node of the tree consists of     *)
    (*   pointers to its parent, brother, and son.  In addition each node      *)
    (*   contains a label field.  The following functions are used and         *)
    (*   documented:                                                           *)
    (*                   NewTree : tree                                        *)
    (*                   AddTreeNode(node,label)                               *)
    (*                   DeleteTreeNode(node)                                  *)
    (*                   Parent(node):node                                     *)
    (*                   FirstChild(node):node                                 *)
    (*                   NextSibling(node):node                                *)
    (*                   PrintTree(tree)                                       *)
    (*                                                                         *)
    (***************************************************************************)

    Interface

    type TreeNode = ^TreePointer;
         TreePointer = record
               Name: char;
               Parent,
               Brother,
               Son: TreeNode;
            end;

    Function NewTree( Name : char ) : TreeNode;
    Function Root( Tree : TreeNode ) : TreeNode;
    Function Parent( Node: TreeNode ) : TreeNode;
    Function NextSibling( Node: TreeNode ) : TreeNode;
    Function FirstChild( Node: TreeNode ) : TreeNode;
    Procedure AddTreeNode( Node: TreeNode; Name: char );
    Procedure DeleteTreeNode( Node: TreeNode );
    Procedure PrintTree( Tree : TreeNode );

    Implementation

    (***************************************************************************)
    (*    Name: NewTree                                                        *)
    (*                                                                         *)
    (*    Purpose:  This function creates a new empty tree                     *)
    (*    Input:   None                                                        *)
    (*    Ouput:   Pointer to new tree                                         *)
    (***************************************************************************)

    Function NewTree( Name : char ) : TreeNode;

    var Root : TreeNode;

    begin
       New(root);
       Root^.Name := Name;
       Root^.Parent := nil;
       Root^.Brother := nil;
       Root^.Son := nil;
       NewTree := Root
    end;

    (***************************************************************************)
    (*   Name: Root                                                            *)
    (*                                                                         *)
    (*   Purpose: Returns the root of the given tree                           *)
    (*   Input: Tree - pointer of the first node of tree                       *)
    (*   Output: pointer to the first nodee of the tree (I.E. the root)        *)
    (***************************************************************************)

    Function Root( Tree : TreeNode ) : TreeNode;

    begin
       Root := Tree;
    end;

    (***************************************************************************)
    (*   Name: AddTreeNode                                                     *)
    (*                                                                         *)
    (*   Purpose: This function creates a new tree node with the given value   *)
    (*            as a son of the given node                                   *)
    (*   Input: Parent of node to be inserted                                  *)
    (*          Value for new node                                             *)
    (*   Output: Pointer to the new node                                       *)
    (***************************************************************************)

    Procedure AddTreeNode( Node: TreeNode; Name: char );

    var NewNode: TreeNode;

    begin
       if Node <> nil
          then begin
                  New(NewNode);
                  NewNode^.Name := Name;
                  NewNode^.Parent := Node;
                  NewNode^.Brother := nil;
                  NewNode^.Son := nil;
                  if Node^.Son <> nil
                     then begin
                             Node := Node^.Son;
                             while Node^.Brother <> nil do
                                Node := Node^.Brother;
                             Node^.Brother := NewNode
                          end
                     else Node^.Son := NewNode
               end
          else writeln('AddTreeNode Error --- Given node does not exist ---');
    end;

    (***************************************************************************)
    (*   Name: Parent                                                          *)
    (*                                                                         *)
    (*   Purpose: Returns the parent of the given node if it exists otherwise  *)
    (*            it returns a nil pointer.                                    *)
    (*   Input: Pointer to given node                                          *)
    (*   Output: Pointer to parent of given node                               *)
    (***************************************************************************)

    Function Parent( Node: TreeNode ) : TreeNode;

    begin
       Parent := Node^.Parent
    end;

    (***************************************************************************)
    (*   Name: FirstChild                                                      *)
    (*                                                                         *)
    (*   Purpose: Returns pointer to left most child of given node if it       *)
    (*            exists otherwise returns nil                                 *)
    (*   Input: Pointer to given node                                          *)
    (*   Output: Pointer to firstchild of given node                           *)
    (***************************************************************************)

    Function FirstChild( Node: TreeNode ) : TreeNode;

    begin
       FirstChild := Node^.Son
    end;

    (***************************************************************************)
    (*   Name: NextSibling                                                     *)
    (*                                                                         *)
    (*   Purpose: Returns pointer to the first sibling of the given node if it *)
    (*            otherwise it returns nil                                     *)
    (*   Input: Pointer to given node                                          *)
    (*   Output: Pointer to first sibling                                      *)
    (***************************************************************************)

    Function NextSibling( Node: TreeNode ) : TreeNode;

    begin
       NextSibling := Node^.Brother
    end;

    (***************************************************************************)
    (*   Name: DeleteTreeNode                                                  *)
    (*                                                                         *)
    (*   Purpose: Removes a leaf node from the tree                            *)
    (*   Input: Pointer to node to be deleted                                  *)
    (*   Output: None                                                          *)
    (***************************************************************************)

    Procedure DeleteTreeNode( Node: TreeNode );

    var N,M: TreeNode;

    begin
       if Node <> nil
          then if Node^.Son = nil
                  then begin
                          N := Node^.Parent;
                          if N^.Son = Node
                             then if Node^.Brother = nil
                                    then N^.Son := nil
                                    else N^.Son := Node^.Brother
                             else begin
                                     N := N^.Son;
                                     while N^.Brother <> Node do
                                        N := N^.Brother;
                                     M := N^.Brother;
                                     N^.Brother := M^.Brother
                                  end
                       end
    end;

    (***************************************************************************)
    (*   Name: PrintTree                                                       *)
    (*                                                                         *)
    (*   Purpose:  To print a preorder traversal of the given tree             *)
    (*   Uses: Level - depth in tree                                               *)
    (*   Input: Pointer to root of tree                                        *)
    (*   Output: Printout of tree in preorder                                  *)
    (***************************************************************************)

    Procedure PrintTree( Tree : TreeNode );

    var Level: integer;

       (************************************************************************)
       (*   Name: Traverse                                                     *)
       (*                                                                      *)
       (*   Purpose: a recursive procedure that prints the tree in preorder    *)
       (*   Input: Level - how far to indent data output                       *)
       (*          Node - Node to traverse                                     *)
       (*   Output: Node data                                                  *)
       (************************************************************************)

       Procedure Traverse( Node : TreeNode; var Level : integer );

       var Loop : integer;

       begin
          if Node <> nil
             then with Node^ do
                     begin
                        for Loop := 1 to Level do
                            write('  ');
                        writeln( Name );
                        inc( Level );
                        Traverse( Son,Level );
                        dec( Level );
                        Traverse( Brother,Level );
                     end
       end;

    begin
       Level := 0;
       writeln('      Level');
       writeln('0 1 2 3 4 5 6 7 8');
       writeln('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
       Traverse( Tree,Level )
    end;

    end.

    Program testtree;

    uses tree,crt;

    var root : t;
        n,m: TreePointer;
        x: integer;

    Begin
       x:=999;
       root:=NewTree(x);
       x:=123;
       AddTreeNode(root^,x);
       x:=456;
       AddtreeNode(root^,x);
       x:=567;
       AddtreeNode(root^,x);
       x:=765;
       addtreenode(Firstchild(root^),x);
       x:=678;
       addtreenode(Firstchild(root^),x);
       x:=159;
       addtreenode(Firstchild(Firstchild(root^)),x);
       x:=259;
       addtreenode(Firstchild(Firstchild(root^)),x);
       x:=359;
       addtreenode(Firstchild(Firstchild(root^)),x);
       x:=169;
       addtreenode(Firstchild(Firstchild(root^))^.brother,x);
       x:=269;
       addtreenode(Firstchild(Firstchild(root^))^.brother,x);
       x:=369;
       addtreenode(Firstchild(Firstchild(root^))^.brother,x);
       x:=789;
       addtreenode(Firstchild(root^),x);
       x:=888;
       addtreenode(firstchild(root^)^.brother,x);
       x:=777;
       addtreenode(firstchild(root^)^.brother,x);
       x:=555;
       addtreenode(firstchild(root^)^.brother^.brother,x);
       x:=444;
       addtreenode(firstchild(root^)^.brother^.brother,x);
       clrscr;
       writeln('Tree:');
       printtree(root);
    end.

[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]