<![CDATA[size : 27357
uploaded_on : Mon Jan 4 00:00:00 1999
modified_on : Wed Dec 8 14:03:31 1999
title : AVL Tree
org_filename : AVL.PAS
author : Bruce Christensen
authoremail : brucec@oanet.com
description : AVL trees are binary trees, but should be really called Balanced Binary Trees. They are balanced (or re-balanced) each time there is an node addition/deletion so the right sub-tree of any node has the same number of levels as the left sub-tree (plus or minus one). The "balancing" keeps the binary tree in optimal shape so accessing is as fast as possible.
keywords :
tested : not tested yet
submitted_by : Bruce Christensen
submitted_by_email : brucec@oanet.com
uploaded_by : nobody
modified_by : nobody
owner : nobody
lang : pas
file-type : text/plain
category : pascal-alg-sortsearch
__END_OF_HEADER__
{***********************************************************************
* *
* AVL.PAS *
* *
* Implements a structure and routines manipulate the balanced *
* AVL tree. *
* *
* Modifications *
* ============= *
* *
***********************************************************************}
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 }
]]>