AVL (Balanced) Binary Tree

Bruce Christensen

Delphi Developer

Wed, 18 Jun 1902 08:00:00 GMT

AVL (Balanced) Binary Tree

{.LW 132}
{***********************************************************************
* *
* AVL.PAS *
* *
* Implements a structure and routines manipulate the balanced *
* AVL tree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

{.L-}
{$I OPDEFINE.INC}
{.L+}

Unit AVL ;

Interface
Uses
Printer ;

Const
Max_Tree_Nodes = 500 ; { Constant is significant only if an ordered }
{ array of the AVL tree nodes is desired. }

Type
AVLTreeStr = String[12] ;

BalanceSet = (Left_Tilt , Neutral , Right_Tilt) ;

AVLDataRec = Record
Key : AVLTreeStr ;
RecOfs : LongInt ;
RecNum : Word ;
End ;

AVLPtr = ^AVL_Tree_Rec ;

AVL_Tree_Rec = Record
TreeData : AVLDataRec ;
Balance : BalanceSet ;
Left ,
Right : AVLPtr ;
End ;

TreeRecArray = Array[1..Max_Tree_Nodes] of AVLDataRec ;
{.PA}
Procedure Insert_AVLTree(Var Root : AVLPtr ;
X : AVLDataRec ) ;

Function Search_AVLTree(Var Root : AVLPtr ;
X : AVLDataRec ) : Boolean ;

Function Search( Root : AVLPtr ;
Var X : AVLDataRec ) : Boolean ;

Procedure AVLSort_To_Array(Var Root : AVLPtr ;
Var SortX : TreeRecArray ;
Var Count : Word ) ;

Function Find_AVLNode(Var Root : AVLPtr ;
X : AVLDataRec ) : AVLPtr ;

Procedure Delete_AVLTree(Var Root : AVLPtr ;
X : AVLDataRec ;
Var DelOK : Boolean ) ;

Implementation
{.PA}
{***********************************************************************
* *
* Rotate_Right *
* *
* Re-arranges tree nodes by rotating them to the right. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Rotate_Right(Var Root : AVLPtr) ;
Var
Ptr2 ,
Ptr3 : AVLPtr ;

Begin { Rotate_Right }
Ptr2 := Root^.Right ;
If Ptr2^.Balance = Right_Tilt then
Begin
Root^.Right := Ptr2^.Left ;
Ptr2^.Left := Root ;
Root^.Balance := Neutral ;
Root := Ptr2 ;
End
Else
Begin
Ptr3 := Ptr2^.Left ;
Ptr2^.Left := Ptr3^.Right ;
Ptr3^.Right := Ptr2 ;
Root^.Right := Ptr3^.Left ;
Ptr3^.Left := Root ;

If Ptr3^.Balance = Left_Tilt then
Ptr2^.Balance := Right_Tilt
Else
Ptr2^.Balance := Neutral ;

If Ptr3^.Balance = Right_Tilt then
Root^.Balance := Left_Tilt
Else
Root^.Balance := Neutral ;

Root := Ptr3 ;
End ;

Root^.Balance := Neutral ;

End ; { Rotate_Right }
{.PA}
{***********************************************************************
* *
* Rotate_Left *
* *
* Re-arranges tree nodes by rotating them to the left. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Rotate_Left(Var Root : AVLPtr) ;
Var
Ptr2 ,
Ptr3 : AVLPtr ;

Begin { Rotate_Left }
Ptr2 := Root^.Left ;
If Ptr2^.Balance = Left_Tilt then
Begin
Root^.Left := Ptr2^.Right;
Ptr2^.Right := Root ;
Root^.Balance := Neutral ;
Root := Ptr2 ;
End
Else
Begin
Ptr3 := Ptr2^.Right ;
Ptr2^.Right := Ptr3^.Left ;
Ptr3^.Left := Ptr2 ;
Root^.Left := Ptr3^.Right ;
Ptr3^.Right := Root ;

If Ptr3^.Balance = Right_Tilt then
Ptr2^.Balance := Left_Tilt
Else
Ptr2^.Balance := Neutral ;

If Ptr3^.Balance = Left_Tilt then
Root^.Balance := Right_Tilt
Else
Root^.Balance := Neutral ;

Root := Ptr3 ;
End ;

Root^.Balance := Neutral ;

End ; { Rotate_Left }
{.PA}
{***********************************************************************
* *
* Insert_AVL *
* *
* Workhouse routine to perform node insertion in an AVL tree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Insert_AVL(Var Root : AVLPtr ;
X : AVLDataRec ;
Var InsertedOK : Boolean ) ;
Begin { Insert_AVL }
If Root = Nil then
Begin
New(Root) ;
With Root^ do
Begin
TreeData := X ;
Left := Nil ;
Right := Nil ;
Balance := Neutral ;
End ;

InsertedOK := True ;
End
Else
If X.Key = Root^.TreeData.Key then
Begin
InsertedOK := False ;
Exit ;
End
Else
If X.Key <= Root^.TreeData.Key then
Begin
Insert_AVL(Root^.Left , X , InsertedOK) ;
If InsertedOK then
Case Root^.Balance of
Left_Tilt : Begin
Rotate_Left(Root) ;
InsertedOK := False ;
End ;

Neutral : Root^.Balance := Left_Tilt ;

Right_Tilt : Begin
Root^.Balance := Neutral ;
InsertedOK := False ;
End ;
End ; { Case Root^.Balance of }
End
Else
Begin
Insert_AVL(Root^.Right , X , InsertedOK) ;
If InsertedOK then
Case Root^.Balance of
Left_Tilt : Begin
Root^.Balance := Neutral ;
InsertedOk := False ;
End ;

Neutral : Root^.Balance := Right_Tilt ;

Right_Tilt : Begin
Rotate_Right(Root) ;
InsertedOK := False ;
End ;
End ; { Case Root^.Balance of }
End ;

End ; { Insert_AVL }
{.PA}
{***********************************************************************
* *
* Insert_AVLTree *
* *
* Insert a datum into the AVL tree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Insert_AVLTree(Var Root : AVLPtr ;
X : AVLDataRec ) ;
Var
InsertedOK : Boolean ;

Begin { Insert_AVLTree }
InsertedOK := False ;
Insert_AVL(Root , X , InsertedOK) ;
End ; { Insert_AVLTree }

{***********************************************************************
* *
* Search *
* *
* Search for datum in the AVL tree. This interface routine is *
* needed because of the recursion involved in Search_AVLTree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Function Search( Root : AVLPtr ;
Var X : AVLDataRec ) : Boolean ;
Begin
If Search_AVLTree(Root , X) then
Begin
Move(Root^ , X , SizeOf(AVLDataRec)) ;
Search := True ;
End
Else
Search := False ;
End ;

{***********************************************************************
* *
* Search_AVLTree *
* *
* Search for datum in the AVL tree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Function Search_AVLTree(Var Root : AVLPtr ;
X : AVLDataRec ) : Boolean ;
Begin { Search_AVLTree }
Search_AVLTree := False ;

While Root <> Nil do
Begin
If X.Key > Root^.TreeData.Key then
Root := Root^.Right
Else
Begin
If X.Key < Root^.TreeData.Key then
Root := Root^.Left
Else
{ }
{ A match has been found. }
{ }
Begin
Search_AVLTree := True ;
Exit ;
End ;
End ;
End ;
End ; { Search_AVLTree }

{***********************************************************************
* *
* Traverse_Tree *
* *
* Local recursive routine used to traverse the AVL tree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

PROCEDURE Traverse_Tree(Var Root : AVLPtr ;
Var SortX : TreeRecArray ;
Var Count : Word ) ;
Begin { Traverse_Tree }
If Root <> Nil then
Begin
Traverse_Tree(Root^.Left , SortX , Count) ;
Inc(Count) ;
If Count <= Max_Tree_Nodes then
SortX[Count].Key := Root^.TreeData.Key ;
Traverse_Tree(Root^.Right , SortX , Count) ;
End ;
End ; { Traverse_Tree }

{***********************************************************************
* *
* AVLSort_To_Array *
* *
* Return the tree data in a sorted vector (array). *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure AVLSort_To_Array(Var Root : AVLPtr ;
Var SortX : TreeRecArray ;
Var Count : Word ) ;
Begin { AVLSort_To_Array }
Count := 0 ; { Initialize number of array members. }

{ In-order traverse of the tree. }
Traverse_Tree(Root , SortX , Count) ;
End ; { AVLSort_To_Array }
{.PA}
{***********************************************************************
* *
* Find_AVLNode *
* *
* Return the pointer to a node in the AVL tree for a requested *
* datum. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Function Find_AVLNode(Var Root : AVLPtr ;
X : AVLDataRec ) : AVLPtr ;
Var
No_Match : Boolean ;

Begin { Find_AVLNode }
No_Match := True ;

While (Root <> Nil) and No_Match do
If X.Key > Root^.TreeData.Key then
Root := Root^.Right
Else
If X.Key < Root^.TreeData.Key then
Root := Root^.Left
Else
No_Match := False ;

Find_AVLNode := Root ;
End ; { Find_AVLNode }
{.PA}
{***********************************************************************
* *
* Balance_Right *
* *
* Restores the balanced/near balanced state of an AVL tree by *
* rebalancing a right subtree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Balance_Right(Var Root : AVLPtr ;
Var DelOK : Boolean ) ;
Var
Ptr2 ,
Ptr3 : AVLPtr ;

Balnc2 ,
Balnc3 : BalanceSet ;

Begin { Balance_Right }
Case Root^.Balance of
Left_Tilt : Root^.Balance := Neutral ;

Neutral : Begin
Root^.Balance := Right_Tilt ;
DelOk := False ;
End ;

Right_Tilt : Begin
Ptr2 := Root^.Right ;
Balnc2 := Ptr2^.Balance ;
If not (Balnc2 = Left_Tilt) then
Begin
Root^.Right := Ptr2^.Left ;
Ptr2^.Left := Root ;
If Balnc2 = Neutral then
Begin
Root^.Balance := Right_Tilt ;
Ptr2^.Balance := Left_Tilt ;
DelOk := False ;
End
Else
Begin
Root^.Balance := Neutral ;
Ptr2^.Balance := Neutral ;
End ;

Root := Ptr2 ;
End
Else
Begin
Ptr3 := Ptr2^.Left ;
Balnc3 := Ptr3^.Balance ;
Ptr2^.Left := Ptr3^.Right ;
Ptr3^.Right := Ptr2 ;
Root^.Right := Ptr3^.Left ;
Ptr3^.Left := Root ;

If Balnc3 = Left_Tilt then
Ptr2^.Balance := Right_Tilt
Else
Ptr2^.Balance := Neutral ;

If Balnc3 = Right_Tilt then
Root^.Balance := Left_Tilt
Else
Root^.Balance := Neutral ;
Root := Ptr3 ;
Ptr3^.Balance := Neutral ;
End ;
End ;
End ; { CAse Root^.Balance of }
End ; { Balance_Right }
{.PA}
{***********************************************************************
* *
* Balance_Left *
* *
* Restores the balanced/near balanced state of an AVL tree by *
* rebalancing a left subtree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Balance_Left(Var Root : AVLPtr ;
Var DelOK : Boolean ) ;
Var
Ptr2 ,
Ptr3 : AVLPtr ;

Balnc2 ,
Balnc3 : BalanceSet ;

Begin { Balance_Left }
Case Root^.Balance of
Left_Tilt : Root^.Balance := Neutral ;

Neutral : Begin
Root^.Balance := Left_Tilt ;
DelOk := False ;
End ;

Right_Tilt : Begin { Right_Tilt }
Ptr2 := Root^.Left ;
Balnc2 := Ptr2^.Balance ;
If not (Balnc2 = Right_Tilt) then
Begin
Root^.Left := Ptr2^.Right ;
Ptr2^.Right := Root ;
If Balnc2 = Neutral then
Begin
Root^.Balance := Left_Tilt ;
Ptr2^.Balance := Right_Tilt ;
DelOk := False ;
End
Else
Begin
Root^.Balance := Neutral ;
Ptr2^.Balance := Neutral ;
End ;

Root := Ptr2 ;
End
Else
Begin
Ptr3 := Ptr2^.Right ;
Balnc3 := Ptr3^.Balance ;
Ptr2^.Right := Ptr3^.Left ;
Ptr3^.Left := Ptr2 ;
Root^.Left := Ptr3^.Right ;
Ptr3^.Right := Root ;

If Balnc3 = Right_Tilt then
Ptr2^.Balance := Left_Tilt
Else
Ptr2^.Balance := Neutral ;

If Balnc3 = Left_Tilt then
Root^.Balance := Right_Tilt
Else
Root^.Balance := Neutral ;

Root := Ptr3 ;
Ptr3^.Balance := Neutral ;
End ;
End ; { Right_Tilt }
End ; { Case Root^.Balance of }
End ; { Balance_Left }
{.PA}
{***********************************************************************
* *
* Delete_Both_Children *
* *
* Delete a node with two empty subtrees. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Delete_Both_Children(Var Root ,
Ptr : AVLPtr ;
Var DelOK : Boolean ) ;
Begin { Delete_Both_Children }
If Ptr^.Right = Nil then
Begin
Root^.TreeData := Ptr^.TreeData ;
Ptr := Ptr^.Left ;
DelOk := True ;
End
Else
Begin
Delete_Both_Children(Root , Ptr^.Right , DelOK) ;
If DelOk then
Balance_Left(Ptr , DelOK) ;
End ;
End ; { Delete_Both_Children }
{.PA}
{***********************************************************************
* *
* Delete_AVL *
* *
* Recursive routine used for node deletion. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Delete_AVL(Var Root : AVLPtr ;
X : AVLDataRec ;
Var DelOK : Boolean ) ;
Var
Ptr : AVLPtr ;

Begin { Delete_AVL }
If Root = Nil then
DelOK := False
Else
If X.Key < Root^.TreeData.Key then
Begin
Delete_AVL(Root^.Left , X , DelOK) ;
If DelOK then
Balance_Right(Root , DelOK) ;
End
Else
If X.Key > Root^.TreeData.Key then
Begin
Delete_AVL(Root^.Right , X , DelOK) ;
If DelOK then
Balance_Left(Root , DelOK) ;
End
Else
Begin
Ptr := Root ;
If Root^.Right = Nil then
Begin
Root := Root^.Left ;
DelOK := True ;
End
Else
Begin
Delete_Both_Children(Root , Root^.Left , DelOK) ;
If DelOK then
Balance_Right(Root , DelOK) ;
End ;
End ;

Dispose(Ptr) ;
End ; { Delete_AVL }
{.PA}
{***********************************************************************
* *
* Delete_AVLTree *
* *
* Deletes the key of X if it is present in the AVL tree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}

Procedure Delete_AVLTree(Var Root : AVLPtr ;
X : AVLDataRec ;
Var DelOK : Boolean ) ;
Begin { Delete_AVLTree }
DelOK := False ;

Delete_AVL(Root , X , DelOK) ;
End ; { Delete_AVLTree }

Begin { AVL_Tree }
End. { AVL_Tree }

Other Threads

1. AVL tree (balanced binary tree) implementation needed

2. Binary trees (better than AVL) source available

3. The use of coprcessor reals (previously Re: Stack overflow at binary tree balance)

4. Stack overflow at binary tree balance

5. Build balanced binary tree

6. HELP balanced binary tree

7. Looking for Expresion Tree/Binary Tree algorythms

8. I want to create a graphical tree as the binary tree

9. Does anyone have any precedures for avl trees?

10. AVL tree code (TP 7.0)