Basic Binary Tree Class - Delphi/Pascal

• Tweet
• 

        Basic Delphi/Pascal class that allows use of a binary tree. The class needs to be modified to be used for searches - it currently doesn't add new nodes in the correct position (this is left up to the user). This is trivial to accomplish however.

unit uBinaryTree;

interface

type
  PBinaryTreeNode = ^TBinaryTreeNode;
  TBinaryTreeNode = record
      Name : string;
      ID : Integer;
      Right : PBinaryTreeNode;
      Left : PBinaryTreeNode;
      Parent : PBinaryTreeNode;
  end;

  PBinaryTree = ^TBinaryTree;
  TBinaryTree = class
    Private
      CurrentCreateID : Integer; //For creating new nodes
      CurrentNode : PBinaryTreeNode; //For traversing
      Root : TBinaryTreeNode;

      Procedure Traverse(Node : PBinaryTreeNode);

      Procedure PreOrderRecursive(Node : PBinaryTreeNode);
      Procedure InOrderRecursive(Node : PBinaryTreeNode);
      Procedure PostOrderRecursive(Node : PBinaryTreeNode);
    Public
      Constructor Create(Name : String);

      Function GetName : String;
      Procedure ChangeName (NewName : String);

      Function TraverseLeft : Integer;
      Function TraverseRight : Integer;
      Function TraverseUp : Integer;

      Procedure Reset;

      Procedure AddLeft;
      Procedure AddRight;

      Procedure RemoveLeft;
      Procedure RemoveRight;

      Function PreOrder()  : Integer;
      Function InOrder() : Integer;
      Function PostOrder() : Integer;
  end;

implementation

Constructor TBinaryTree.Create(Name : string);
begin
  CurrentCreateID := 1;
  Root.ID := CurrentCreateID;
  Root.Right := Nil;
  Root.Left := Nil;
  Root.Parent := Nil;
  CurrentNode := @Root;
  ChangeName(Name);
  inc(CurrentCreateID);
end;

Procedure TBinaryTree.Traverse(Node: PBinaryTreeNode);
begin
  CurrentNode := Node;
end;

Function TBinaryTree.GetName : string;
begin
  Result := CurrentNode.Name;
end;

Procedure TBinaryTree.ChangeName(NewName: string);
begin
  CurrentNode.Name := NewName;
end;

Function TBinaryTree.TraverseLeft : Integer;
begin
  if (CurrentNode.Left <> Nil) then
  begin
    CurrentNode := CurrentNode.Left;
    Result := 1;
  end
  else
    Result := -1;
end;

Function TBinaryTree.TraverseRight : Integer;
begin
  if (CurrentNode.Right <> Nil) then
  begin
    CurrentNode := CurrentNode.Right;
    Result := 1;
  end
  else
    Result := -1;
end;

Function TBinaryTree.TraverseUp : Integer;
begin
  if (CurrentNode.Parent <> Nil) then
  begin
    CurrentNode := CurrentNode.Parent;
    Result := 1;
  end
  else
    Result := -1;
end;

Procedure TBinaryTree.Reset;
begin
  while TraverseUp <> -1 do
  ; //Do nothing until we reach Root node
end;

Procedure TBinaryTree.AddLeft;
var
  P : PBinaryTreeNode;
begin
  New(P); //assign memory for pointer data

  P^.Name := '';
  P^.ID := CurrentCreateID;
  P^.Right := Nil;
  P^.Left := Nil;
  P^.Parent := CurrentNode;

  CurrentNode^.Left := P; //update parent node

  inc(CurrentCreateID);
end;

Procedure TBinaryTree.AddRight;
var
  P : PBinaryTreeNode;
begin
  New(p);

  P^.Name := '';
  P^.ID := CurrentCreateID;
  P^.Right := Nil;
  P^.Left := Nil;
  P^.Parent := CurrentNode;

  CurrentNode^.Right := P;

  inc(CurrentCreateID);
end;

Procedure TBinaryTree.RemoveLeft;
var
  StartNode, tmpNode : PBinaryTreeNode;
begin
  StartNode := CurrentNode; //save initial node
  StartNode.Left := Nil;

  while TraverseLeft <> -1 do
  ; //get to bottom of the left tree

  while CurrentNode <> StartNode do
  begin
    if TraverseRight = -1 then //no right nodes to dispose of
    begin
      tmpNode := CurrentNode.Parent;
      dispose(CurrentNode);
      Traverse(tmpNode);
    end
  end;
end;

Procedure TBinaryTree.RemoveRight;
var
  StartNode, tmpNode : PBinaryTreeNode;
begin
  StartNode := CurrentNode; //save initial node
  StartNode.Right := Nil;

  while TraverseRight <> -1 do
  ; //get to bottom of the right tree

  while CurrentNode <> StartNode do
  begin
    if TraverseLeft = -1 then //no left nodes to dispose of
    begin
      tmpNode := CurrentNode.Parent;
      dispose(CurrentNode);
      Traverse(tmpNode);
    end
  end;
end;

Function TBinaryTree.PreOrder : Integer;
begin
  Reset;
  PreOrderRecursive(CurrentNode);
  Result := 1; //until searching is implemented
end;

Procedure TBinaryTree.PreOrderRecursive (Node : PBinaryTreeNode);
begin
  write(Node.Name);
  if Node.Left <> Nil then PreOrderRecursive(Node.Left);
  if Node.Right <> Nil then PreOrderRecursive(Node.Right);
end;

Function TBinaryTree.InOrder : Integer;
begin
  Reset;
  InOrderRecursive(CurrentNode);
  Result := 1; //until searching is implemented
end;

Procedure TBinaryTree.InOrderRecursive (Node : PBinaryTreeNode);
begin
  if Node.Left <> Nil then PreOrderRecursive(Node.Left);
  write(Node.Name);
  if Node.Right <> Nil then PreOrderRecursive(Node.Right);
end;

Function TBinaryTree.PostOrder : Integer;
begin
  Reset;
  PostOrderRecursive(CurrentNode);
  Result := 1; //until searching is implemented
end;

Procedure TBinaryTree.PostOrderRecursive (Node : PBinaryTreeNode);
begin
  if Node.Left <> Nil then PreOrderRecursive(Node.Left);
  if Node.Right <> Nil then PreOrderRecursive(Node.Right);
  write(Node.Name);
end;

end.

Tags:
• binary
• class
• Delphi
• luke mitchell
• Pascal
• search
• Tree