Algorithm Implementation/Trees/AVL tree

AVL tree A Visual Basic 6.0 implementation (01/11/2014 update) Option Explicit '_______________________________________________________________________________ ' 'ABSTRACT ' Provides any amount of requested memory (as long as there is available RAM) ' and associates that memory with a user-defined alphanumeric key. Features ' very fast retrieval in sorted order, even faster sequential access (in ' the chronological order the requests were made). '_______________________________________________________________________________ ' 'DESCRIPTION ' The alphanumeric keys are associated with a certain quantity of bytes located ' at a designated position in RAM. That RAM is and remains exclusively reserved ' for that Key. Via the key the address can be returned, and also the reserved ' bytes at that address. Keys are internally managed with a balanced binary AVL ' tree. It is possible to iterate through the whole collection of keys in the ' order in which these keys were created (and the memory allocated), returning ' the Key, the Address and the Size. It is also possible to access all the ' Keys in sorted order (ascending as well as descending). All operations are ' considerabily faster than VB's Collection object (as far as provided by the ' Collection). '_______________________________________________________________________________ ' 'USAGE ' What you do with the provided memory is up to you; however this is optimal ' to store objects' addresses (available via ObjPtr) to circumvent the slow ' COM mechanisms. '_______________________________________________________________________________ ' 'WARNINGS ' * Whatever you do with the allocated memory, do not forget to free it ' ("Set ThisClassesObject = Nothing" will do), or you soon end up with a lot ' of blocked RAM which won't be freed until a restart. ' * Do not attempt to write data beyond the end of the requested and allocated ' memory fragment! Chances are you get a crash if you do. '_______________________________________________________________________________ ' 'AUTHOR ' This software is (c) 2005-2014 by Herbert Glarner. ' The used TypeLib for the IMalloc interface is (c) by Brad Martinez. '_______________________________________________________________________________ ' 'HISTORY ' 04 Apr 2005 1.0 Creation and Access functionality ' 05 Apr 2005 1.1 Replaced StrComp, Keys stored as Byte Arrays ' 07 Apr 2005 Fixed a bug in IStrComp ' 11 Jan 2014 Update '_______________________________________________________________________________ ' 'PROJECT FILES ' SatAVL.cls (This file) '_______________________________________________________________________________ ' 'USED TEST FORM ' SatAVLTest.frm (Test scenarioes and parallel comparison with VB Collection) '_______________________________________________________________________________ ' 'REQUIRED TYPE LIBRARIES ' ISHF_Ex.tlb "IShellFolder Extended type Library v1.2" ' (The TypeLib is (c) by Brad Martinez) '_______________________________________________________________________________ ' 'REQUIRED DLLS ' shell32 (for "SHGetMalloc") '_______________________________________________________________________________ ' 'REQUIRED CONTROLS ' - '_______________________________________________________________________________ ' 'EVENTS ' - ' 'PUBLIC PROPERTIES ' R Nodes = Count Use to traverse by index 0...n-1 ' 'PUBLIC METHODS ' Address = Add (Key, Bytes) already existing: 0, else RAM ' 'LEXICAL ACCESS (SORTED BY KEY) ' Index = Lowest/Higher ascending, No more items: -1 ' Index = Highest/Lower descending, No more items: -1 ' 'DIRECT ACCESS (with result, use sequential access methods "Address" etc.) ' Index = Item (Key) not existing returns -1 ' 'SEQUENTIAL ACCESS (IN APPENDING ORDER), ALSO DIRECT ACCESS WITH KNOWN INDEX ' Key = Key (Index) Index=0...n-1, n.ex. returns "" ' Address = Address (Index) Index=0...n-1, n.ex. returns 0 ' Bytes = Size (Index) Index=0...n-1, n.ex. returns 0 '_______________________________________________________________________________ ' 'EXTERNAL DLL METHODS 'IMalloc is available via the type library "ISHF_Ex.tlb" which has to be 'included into the project's references when used in the IDE. Private Const NOERROR = 0 Private Declare Function SHGetMalloc Lib "shell32" _ (ppMalloc As IMalloc) As Long '_______________________________________________________________________________ ' 'ERRORS (Base Number for this class: 4k) '(Dont't forget to initialize descriptions in the Constructor) Private Const ErrClass As String = "SatAVL" Private Enum ErrNumber ErrBase = 4& * 1024& 'Raised in: ErrNoMallocInterface = ErrBase + 0 'Initialize ErrFatalAdd = ErrBase + 1 'Add ErrFatalItem = ErrBase + 2 'Item 'Always leave as the last entry: ErrAutoMax End Enum 'Descriptions initialized on Construction Private ErrDesc(ErrBase + 0 To ErrAutoMax - 1) As String '_______________________________________________________________________________ ' 'CONSTANTS 'Increasing elements vPath() if necessary. Private Const NEWELEMENTS As Long = 10 'Elements in rNode having no pointer to another index. Private Const sstNoChild As Long = -1 Private Const sstNoParent As Long = -1 'StrComp results. Private Const sstKeyIsSmaller As Long = -1 Private Const sstKeyIsEqual As Long = 0 Private Const sstKeyIsLarger As Long = 1 'Used in Balance calculation for Height fields of the UDT "rChunk". Private Const ssmbLeftHeavy As Integer = -2 Private Const ssmbLeftBalanced As Integer = -1 Private Const ssmbBalanced As Integer = 0 Private Const ssmbRightBalanced As Integer = 1 Private Const ssmbRightHeavy As Integer = 2 '_______________________________________________________________________________ ' 'ENUMS 'Used in the Direction field of the UDT rPath (see below). Private Enum ssmDirection ssmdLeft ssmdRight End Enum '_______________________________________________________________________________ ' 'UDTS 'Able to handle up to 2G nodes (signed Long referring to indices). Private Type rNode 'The key and a reference to its content. (I've tested Key being an 'Integer() array, converted into a such from an ordinary key via mapping 'in Add(), so that only new keys needed to be mapped and the existing ones 'were in Integer() format. However, key comparison takes up to 50% longer 'time than the already slow string comparison, so it's strings again.) '(Seems that I could manage a slightly faster string comparison with 'Byte arrays.) ByteKey() As Byte 'Key As String 'Provided by user, must be unique Address As Long 'Memory allocated via Malloc Bytes As Long 'As per user request, any number 'Some links regarding the balanced binary tree ("Index" is the index of an 'array in which this rChunk record is held among all relatives). Here we 'definitely need Longs to care for more than 2^15 nodes. LeftTree As Long 'Index of left subtree RightTree As Long 'Index of right subtree Parent As Long 'Index of the parent entry '(Integers rather Longs here to save 4 bytes; Integers with 2^15 entries for 'the height should do the job: never encountered something such high due to 'tree balancing. Approx. 1 million nodes need height < 40. Still I feel 'that a byte is a risk, and there's also no need to save 2 bytes, since 'alignment will use them anyway. I've also tested Long'anyway with writing and 'accessing 1 million nodes: The time difference is not noticeable (once more, 'once less time). LeftHeight As Integer 'This node's left height (excl. this node) RightHeight As Integer 'This node's right height (excl. this node) End Type 'Detailled description see VARIABLES for "vPath()". Private Type rPath Index As Long Direction As ssmDirection 'Left or right Path End Type '_______________________________________________________________________________ ' 'EVENTS ' None '_______________________________________________________________________________ ' 'VARIABLES 'Holds a reference to the IMalloc Interface, available via the type library 'ISHF_Ex.tlb to which a VB Project reference must be set to use it. Set on 'object construction, and destroyed on object destruction. The pointer is not 'made available to the external world; it is used object internally only to 'allocate resp. free memory. Private ifMalloc As IMalloc 'This vector holds the balanced binary tree. In case that no "Alloc" was made 'so far, it is completely empty. With the first "Alloc" a first element (the 'root) is allocated. Private vBinTree() As rNode Private lBinTreeMax As Long 'The same as UBound(vBinTree) Private lBinTreeNext As Long '0=empty, 1=only 0 exists etc. Private lBinTreeRoot As Long 'Initially 0, later anywhere (due to balancing) 'When adding a node, we need to keep track of the visited path, because we do 'not know before the very insertion if a tree grows higher or not. If it does, 'this may affect some or all nodes back up to the root, which we do not want to 'track again when we already have visited them: Instead their indices and also 'the direction we took (left/right) is held in this vector. Private vPath() As rPath 'Never shrinks Private lPathMax As Long 'The same as UBound(vPath) Private lPathAct As Long 'Current pointer (0=start) 'Last accessed node via "Item", store the continuation points for some public 'methods like "Higher", "Lower" etc. Private bLastAcc() As Byte 'Last searched Key via "Item". Private lLastAcc As Long 'It's index; any "Add" invalidates this (-1). '_______________________________________________________________________________ 'CONSTRUCTION AND DESTRUCTION ' Private Sub Class_Initialize() 'Load error messages ErrDesc(ErrNoMallocInterface) = "Creation of a reference to the IMalloc interface failed." ErrDesc(ErrFatalAdd) = "Fatal Error in Add" ErrDesc(ErrFatalItem) = "Fatal Error in Item" 'Returns a reference to the IMalloc interface. With it we can create and 'destroy memory. Destroyed on object destruction. If Not (SHGetMalloc(ifMalloc) = NOERROR) Then 'We could not obtain a reference to the interface. Err.Raise ErrNoMallocInterface, ErrClass, ErrDesc(ErrNoMallocInterface) End If 'Create some initial nodes for the binary tree. Note, that we are going to '*double* this as soon as it does not suffice anymore (adding a constant 'number *always* becomes a bottleneck at some point of time (when adding lots 'of elements), even if it's 10000). lBinTreeMax = 2& ReDim vBinTree(0& To lBinTreeMax) As rNode lBinTreeNext = 0& lBinTreeRoot = 0& 'Initial vPath() dimensioning to avoid testing for an empty vector. lPathMax = NEWELEMENTS - 1& ReDim vPath(0& To lPathMax) As rPath End Sub Private Sub Class_Terminate() 'Walking the whole binary tree and freeing all allocated memory. If vBinTree(lBinTreeRoot).Address > 0 Then FreeMemory lBinTreeRoot End If Erase vBinTree 'Destroy the reference to the IMalloc object, which was created on object 'Construction. Set ifMalloc = Nothing End Sub 'Recursive procedure to free all allocated memory on object destruction. Private Sub FreeMemory(ParentIndex As Long) Dim lChildIndex As Long lChildIndex = vBinTree(ParentIndex).LeftTree If lChildIndex <> sstNoChild Then FreeMemory lChildIndex lChildIndex = vBinTree(ParentIndex).RightTree If lChildIndex <> sstNoChild Then FreeMemory lChildIndex 'Freeing the memory for this ParentIndex ifMalloc.Free ByVal vBinTree(ParentIndex).Address End Sub '_______________________________________________________________________________ 'PUBLIC PROPERTIES 'Returns 0 if there are no nodes at all. Note that indices for sequential access 'methods are 0-based (thus 0...Count-1). Public Property Get Count() As Long Count = lBinTreeNext End Property '_______________________________________________________________________________ 'PUBLIC METHODS '"Add" requests "Bytes" of memory for free usage and associates this memory 'with "Key". Returns the *ADDRESS* of the allocated memory (ideal for CopyMemory). 'Returns 0 if the Key already exists (treat that as an error or read the 'original node ("Item" method) and react accordingly, but never assign data to 'the memory address 0 because your App would undoubtedly crash). Public Function Add(ByRef Key As String, Bytes As Long) As Long Dim lActNode As Long Dim lChildNode As Long Dim lActChar As Long Dim lNewNode As Long Dim lStrComp As Long Dim bKey() As Byte '___________________________________________________________________________ 'Copy the string into a Byte array bKey = Key '___________________________________________________________________________ 'If the tree is still empty, create the first root node directly. If lBinTreeNext = 0& Then 'Create the very first node, being the first root. lNewNode = MakeNode(sstNoParent, bKey, Bytes) 'Return its address to the caller Add = vBinTree(lNewNode).Address Exit Function End If '___________________________________________________________________________ 'Beginning with the tree's root. lActNode = lBinTreeRoot 'Initialize the path vector to trace the nodes we will see. Used to update 'and balance the binary tree. vPath() was initially dimensioned with 0...9 'when the object was constructed; later it holds its highest height. 'Whenever needed, vPath() is increased by 10 elements (due to tree balancing 'this won't be the case often: even with 1 million elements we usually get 'away with less than 40 elements). lPathAct points to the actual element. lPathAct = 0& 'Looping until we created a new leaf. '(No recursion here please, a simple loop will do the job and contributes 'much to performance.) Do 'Updating the path we took vPath(lPathAct).Index = lActNode 'Comparing new key with existing key (StrComp is significantly faster 'than two string comparisons with "<" and "=". (Adding 1 million nodes 'in my test with random 8 char long alpha keys results in 20204798 'string comparisons.) ' < and =: 1000000 Adds: 65.2293464672184 sec net excl overhead ' lStrComp: 1000000 Adds: 61.7483442728189 sec net excl overhead '(Still this comparison is a bottleneck in mass Add: It takes approx. '50% of the time of the whole procedure.) '"StrComp" seems to return a Variant ... '(StrComp() is slower than CLong(StrComp()) and this slower than my function.) 'lStrComp = StrComp(Key, vBinTree(lActNode).Key, vbBinaryCompare) 'lStrComp = CLng(StrComp(Key, vBinTree(lActNode).Key, vbBinaryCompare)) lStrComp = IStrComp(bKey, vBinTree(lActNode).ByteKey) 'Results in lStrComp: -1 when Key smaller, +1 when larger, 0 when equal. 'We test ssmdRight first, because *all* keys qualify only here if they 'are fed in sorted order; otherwise (random feed) they are almost 'equally distributed. (First branch in Ifs is executed slightly faster.) If lStrComp = sstKeyIsLarger Then 'Right child 'Updating the path we took vPath(lPathAct).Direction = ssmdRight lChildNode = vBinTree(lActNode).RightTree If lChildNode = sstNoChild Then 'Make a new left child node and link it as a child of the 'actual node (being the parent now for the new node). lNewNode = MakeNode(lActNode, bKey, Bytes) vBinTree(lActNode).RightTree = lNewNode 'Heights of the path need to be updated UpdateHeights 'Return address to caller and leave Add = vBinTree(lNewNode).Address Exit Function End If ElseIf lStrComp = sstKeyIsSmaller Then 'Left child 'Updating the path we took vPath(lPathAct).Direction = ssmdLeft lChildNode = vBinTree(lActNode).LeftTree If lChildNode = sstNoChild Then 'Make a new left child node and link it as a child of the 'actual node (being the parent now for the new node). lNewNode = MakeNode(lActNode, bKey, Bytes) vBinTree(lActNode).LeftTree = lNewNode 'Heights of the path need to be updated UpdateHeights 'Return address to caller and leave Add = vBinTree(lNewNode).Address Exit Function End If Else 'This key already exists. 'We do not interrupt the client's normal program flow with urging him 'to react on an error here, but we return 0 and expect him to check 'for this (invalid) value, except when he is sure that no identical 'keys do exist. Add = 0 Exit Function End If 'Redimensioning the vPath() vector in steps of 10 if needed. Will be 'executed rarely (in general less than 40 elements for 1 million nodes). If lPathAct = lPathMax Then lPathMax = lPathMax + NEWELEMENTS ReDim Preserve vPath(0& To lPathMax) As rPath End If lPathAct = lPathAct + 1& 'Following the child's left or right child now. lActNode = lChildNode Loop '___________________________________________________________________________ 'Not a valid exit point: We never should arrive here. Err.Raise ErrFatalAdd, ErrClass, ErrDesc(ErrFatalAdd) End Function 'This returns the *index* of the memory associated with the provided key (or -1 'if such a key does not exist). With the index, use the very fast index 'functions to retrieve the associated data (methods "Key", "Address", "Size"). Public Function Item(ByRef Key As String) As Long Dim lStrComp As Long Dim bKey() As Byte '___________________________________________________________________________ 'Copy string into byte array bKey = Key 'Register this access. bLastAcc = bKey 'Begin with root node. lLastAcc = lBinTreeRoot Do 'StrComp is significantly faster than two comparisons with "<" and "=". ' < and =: Retrieved all 1000000 nodes by key: 22.78 sec (43896/sec) ' StrComp: Retrieved all 1000000 nodes by key: 18.67 sec (53558/sec) 'Returns -1 if first string is smaller, 1 if larger, 0 if equal. '(Still this comparison is a bottleneck: The following line takes up 'to 60% of the whole procedure's time. StrComp returns a Variant...) '(StrComp() is slower than CLong(StrComp()) and this slower than my function.) 'lStrComp = StrComp(Key, vBinTree(lLastAcc).Key, vbBinaryCompare) 'lStrComp = CLng(StrComp(Key, vBinTree(lLastAcc).Key, vbBinaryCompare)) lStrComp = IStrComp(bKey, vBinTree(lLastAcc).ByteKey) If lStrComp = sstKeyIsSmaller Then 'Continue with left subtree lLastAcc = vBinTree(lLastAcc).LeftTree ElseIf lStrComp = sstKeyIsLarger Then 'Continue with right subtree lLastAcc = vBinTree(lLastAcc).RightTree Else '0 as the last case: Lowest chances to hit. 'Found Item = lLastAcc 'lLastAccPred Exit Function End If If lLastAcc = sstNoChild Then 'Not existing bLastAcc = "" Item = sstNoChild Exit Function End If Loop 'Never should arrive here Err.Raise ErrFatalItem, ErrClass, ErrDesc(ErrFatalItem) End Function 'Accessing the nodes as per sorted key order (lexicographically). 'These methods return the INDICES and *not* the addresses already; this is because 'the user most likely also wants to access the key, which is cheap when having the 'index. Do *not* store the index: Each additional "Add" might change it drastically. Public Function Lowest() As Long 'Begin with root node. lLastAcc = lBinTreeRoot 'Follow all left subtrees until there are no more. Do While vBinTree(lLastAcc).LeftTree <> sstNoChild lLastAcc = vBinTree(lLastAcc).LeftTree Loop 'Store as the actual node. bLastAcc = vBinTree(lLastAcc).ByteKey 'Return result (INDEX, not address). Lowest = lLastAcc End Function Public Function Higher() As Long 'Use after Lowest 'Having an index in lLastAcc we find the successor of that node. 'If lLastAcc has a right child, then its successor is the minimum in the 'right subtree. If vBinTree(lLastAcc).RightTree <> sstNoChild Then 'Access right subtree. lLastAcc = vBinTree(lLastAcc).RightTree 'From there follow all left subtrees until there are no more. Do While vBinTree(lLastAcc).LeftTree <> sstNoChild lLastAcc = vBinTree(lLastAcc).LeftTree Loop 'Store as the actual node. bLastAcc = vBinTree(lLastAcc).ByteKey Else 'No right subtree. Find the lowest ancestor of lLastAcc, whose 'left child is also an ancestor of lLastAcc. 'Follow parent pointers from lLastAcc, until reaching a key larger 'than lLastAcc's key (if there is none, then lLastAcc is the maximum). Do lLastAcc = vBinTree(lLastAcc).Parent If lLastAcc = sstNoParent Then 'Is already highest item: No successor is available. bLastAcc = "" Exit Do ElseIf IStrComp(vBinTree(lLastAcc).ByteKey, bLastAcc) = sstKeyIsLarger Then 'Found: Store as the actual node (just because it becomes cheap). bLastAcc = vBinTree(lLastAcc).ByteKey Exit Do End If Loop 'lLastAcc is either the successor or -1 (already highest item) End If 'Return result (INDEX, not address). Higher = lLastAcc End Function Public Function Highest() As Long 'Begin with root node. lLastAcc = lBinTreeRoot 'Follow all right subtrees until there are no more. Do While vBinTree(lLastAcc).RightTree <> sstNoChild lLastAcc = vBinTree(lLastAcc).RightTree Loop 'Store as the actual node. bLastAcc = vBinTree(lLastAcc).ByteKey 'Return result (INDEX, not address). Highest = lLastAcc End Function Public Function Lower() As Long 'Use after Highest 'Having an index in lLastAcc we find the predecessor of that node. 'If lLastAcc has a left child, then its predecessor is the maximum in the 'left subtree. If vBinTree(lLastAcc).LeftTree <> sstNoChild Then 'Access left subtree. lLastAcc = vBinTree(lLastAcc).LeftTree 'From there follow all right subtrees until there are no more. Do While vBinTree(lLastAcc).RightTree <> sstNoChild lLastAcc = vBinTree(lLastAcc).RightTree Loop 'Store as the actual node (just because it becomes cheap). bLastAcc = vBinTree(lLastAcc).ByteKey Else 'No left subtree. Find the lowest ancestor of lLastAcc, whose 'right child is also an ancestor of lLastAcc. 'Follow parent pointers from lLastAcc, until reaching a key smaller 'than lLastAcc's key (if there is none, then lLastAcc is the minimum). Do lLastAcc = vBinTree(lLastAcc).Parent If lLastAcc = sstNoParent Then 'Is already smallest item: No predecessor is available. bLastAcc = "" Exit Do ElseIf IStrComp(vBinTree(lLastAcc).ByteKey, bLastAcc) = sstKeyIsSmaller Then 'Found: Store as the actual node (just because it becomes cheap). bLastAcc = vBinTree(lLastAcc).ByteKey Exit Do End If Loop 'lLastAcc is either the successor or -1 (already highest item) End If 'Return result (INDEX, not address). Lower = lLastAcc End Function 'Accessing the nodes by their insertion order (0=first, lBinTreeNext-1=last). 'Returns the address of the node, or 0 if there is no such index. Public Function Address(Index As Long) As Long If Index >= lBinTreeNext Then Address = 0 ElseIf Index < 0 Then Address = 0 Else Address = vBinTree(Index).Address End If End Function 'Returns the reserved memory of the node 8in bytes), or 0 if there is no such index. Public Function Size(Index As Long) As Long If Index >= lBinTreeNext Then Size = 0 ElseIf Index < 0 Then Size = 0 Else Size = vBinTree(Index).Bytes End If End Function 'Returns the key of the node, or a null-length string ("") if there is no 'such index. Public Function Key(Index As Long) As String If Index >= lBinTreeNext Then Key = "" ElseIf Index < 0 Then Key = "" Else 'Return as a string, user is not interested in a Byte Array Key = vBinTree(Index).ByteKey End If End Function '_______________________________________________________________________________ 'INTERNAL ROUTINES 'Creating a new node below a given parent. Returns the index into vBinTree(). Private Function MakeNode(ParentIndex As Long, ByRef Key() As Byte, Bytes As Long) As Long 'If this new node requires that we make new elements to hold more nodes, 'we expand our vector by doubling it (a constant number of elements *always* 'becomes a bottleneck at some point of time, even if it's 1000). If lBinTreeNext > lBinTreeMax Then lBinTreeMax = lBinTreeMax * 2 ReDim Preserve vBinTree(0 To lBinTreeMax) As rNode End If 'lBinTreeNext is the element index into the vector. With vBinTree(lBinTreeNext) .ByteKey = Key .Address = ifMalloc.Alloc(Bytes) .Bytes = Bytes .Parent = ParentIndex .LeftTree = sstNoChild .RightTree = sstNoChild End With 'Return the index as this function's result MakeNode = lBinTreeNext 'Prepare for next node. lBinTreeNext = lBinTreeNext + 1& End Function 'BALANCING THE TREE 'Depending on the nodes' actual balances, one of four balancing activities can 'be called (BalanceLL, BalanceRR, BalanceLR or BalanceRL). In a test scenario 'with 1 million nodes with 8 char long RANDOM keys consisting of all upper- and 'lowercase alphabetic characters A...Z and a...z, the balancing routines were 'called so many times: With 1 mill already SORTED input (key length 4): ' Rebalances LL 119628 0 ' Rebalances RR 118737 999980 ' Rebalances LR 114924 0 ' Rebalances RL 115005 0 ' Total 468294 999980 Private Sub UpdateHeights() Dim lLevel As Long Dim lNode As Long Dim lLeftTree As Long Dim lRightTree As Long Dim iUpperBalance As Integer 'Integer to match UDT definition Dim iLowerBalance As Integer 'Integer to match UDT definition Dim iNewHeight As Integer 'Integer to match UDT definition '___________________________________________________________________________ 'Must be reverse height, because we might break update for upper levels. For lLevel = lPathAct To 0& Step -1& lNode = vPath(lLevel).Index 'Increase height along path. Direction is either ssmdLeft or ssmdRight. 'If the Keys are fed sorted, only ssmdRight will appear (if fed in 'random order, there are almost equal chances for the left and the right 'path): For this reason, ssmdRight is tested first (slightly faster). If vPath(lLevel).Direction = ssmdRight Then iNewHeight = vBinTree(lNode).RightHeight + 1& vBinTree(lNode).RightHeight = iNewHeight 'If right was *not* responsible for a height increase, this breaks 'the update (no propagation farther up). If iNewHeight <= vBinTree(lNode).LeftHeight Then Exit For End If Else iNewHeight = vBinTree(lNode).LeftHeight + 1& vBinTree(lNode).LeftHeight = iNewHeight 'If Left was *not* responsible for a height increase, this breaks 'the update (no propagation farther up). If iNewHeight <= vBinTree(lNode).RightHeight Then Exit For End If End If 'Nodes with a too heavy weight left or right cause a tree balancing 'activity now. Too heavy is, when there is a height difference of +/-2. iUpperBalance = vBinTree(lNode).RightHeight - vBinTree(lNode).LeftHeight 'testing right-heavy first because we want RR to be executed as fast as 'possible to acknowledge that RR type is executed almost always when keys 'are fed already sorted to Add; whereas the distribution of the 4 types 'is almost the same (totalling in about 44%) when the keys are fed in 'random order. If iUpperBalance = ssmbRightHeavy Then 'Node is right-heavy (+2). Examine its right child. lRightTree = vBinTree(lNode).RightTree iLowerBalance = vBinTree(lRightTree).RightHeight - vBinTree(lRightTree).LeftHeight 'Testing ssmbRightBalanced first to take care for the case that 'keys may come in already sorted, in which case 99.8% of all Adds 'require a RR balancing. If keys are fed random, all 4 types are 'equally distributed. If iLowerBalance = ssmbRightBalanced Then 'Left child is right-balanced. RR situation. BalanceRR lNode Else 'Cannot be ssmbBalanced, and so must be ssmbLeftBalanced. BalanceRL lNode End If 'This breaks updates further back! Exit For ElseIf iUpperBalance = ssmbLeftHeavy Then 'Node is left-heavy (-2). Examine its left child. lLeftTree = vBinTree(lNode).LeftTree iLowerBalance = vBinTree(lLeftTree).RightHeight - vBinTree(lLeftTree).LeftHeight If iLowerBalance = ssmbRightBalanced Then 'Left child is right-balanced. LR situation. BalanceLR lNode Else 'Cannot be ssmbBalanced, and so must be ssmbLeftBalanced. BalanceLL lNode End If 'This breaks updates further back! Exit For End If Next lLevel End Sub '_______________________________________________________________________________ ' 'INTERNAL ROUTINES TO BALANCE THE BINARY TREE 'LL - A is the node that the rotation is performed on. This rotation is performed 'when A is unbalanced to the left (the left subtree is 2 higher than the right 'subtree) and B is left-heavy (the left subtree of B is 1 higher than the right 'subtree of B). T1, T2 and T3 represent subtrees (a node was added to T1 which 'made B left-heavy and unbalanced A). P is A's parent and listed only because A's 'relationship with P is taken over by B, making relinks necessary. ' ' P P ' | | ' A B ' / \ ----------> / \ ' B T3 T1 A ' / \ ** / \ ' T1 T2 T2 T3 ' ** '+--+--------+--------+ '| | Before | After | '+--+--+--+--+--+--+--+ '| |LT|RT|PA|LT|RT|PA| '+--+--+--+--+--+--+--+ '|A |B | |P |T2| |B | '|B | |T2|A | |A |P | '|T2| | |B | | |A | '|P | A | | B | | '+--+--+--+--+--+--+--+ ' Private Sub BalanceLL(lA As Long) Dim lB As Long Dim lP As Long Dim lT2 As Long 'Indices of old state lB = vBinTree(lA).LeftTree lT2 = vBinTree(lB).RightTree lP = vBinTree(lA).Parent 'New links vBinTree(lA).LeftTree = lT2 If lT2 <> sstNoChild Then vBinTree(lT2).Parent = lA vBinTree(lB).RightTree = lA vBinTree(lA).Parent = lB If lP <> sstNoParent Then 'A was either P's left or right child, B is taking that place now. vBinTree(lB).Parent = lP If vBinTree(lP).LeftTree = lA Then vBinTree(lP).LeftTree = lB Else vBinTree(lP).RightTree = lB End If Else 'If A was the whole tree's root, then it's role is taken over by B now. vBinTree(lB).Parent = sstNoParent lBinTreeRoot = lB End If 'New weights vBinTree(lA).LeftHeight = vBinTree(lA).LeftHeight - 2 vBinTree(lB).RightHeight = vBinTree(lB).RightHeight + 1 End Sub ' 'RR - A is the node that the rotation is performed on. This rotation is performed 'when A is unbalanced to the right (the right subtree is 2 higher than the left 'subtree) and B is rightheavy (the right subtree of B is 1 higher than the left 'subtree of B). T1, T2 and T3 represent subtrees (a node was added to T3 which 'made B right-heavy and unbalanced A). P is A's parent and listed only because A's 'relationship with P is taken over by B, making relinks necessary. '(This rotation is performed on almost every node if the keys are added in already 'sorted order, and no other rotations are performed at all then.) ' ' P P ' | | ' A B ' / \ ----------> / \ ' T1 B A T3 ' / \ / \ ** ' T2 T3 T1 T2 ' ** '+--+--------+--------+ '| | Before | After | '+--+--+--+--+--+--+--+ '| |LT|RT|PA|LT|RT|PA| '+--+--+--+--+--+--+--+ '|A | |B |P | |T2|B | '|B |T2| |A |A | |P | '|T2| | |B | | |A | '|P | A | | B | | '+--+--+--+--+--+--+--+ ' Private Sub BalanceRR(lA As Long) Dim lB As Long Dim lP As Long Dim lT2 As Long 'Indices of old state lB = vBinTree(lA).RightTree lP = vBinTree(lA).Parent lT2 = vBinTree(lB).LeftTree 'New links vBinTree(lA).RightTree = lT2 If lT2 <> sstNoChild Then vBinTree(lT2).Parent = lA vBinTree(lB).LeftTree = lA vBinTree(lA).Parent = lB If lP <> sstNoParent Then 'A was either P's left or right child, B is taking that place now. vBinTree(lB).Parent = lP If vBinTree(lP).LeftTree = lA Then vBinTree(lP).LeftTree = lB Else vBinTree(lP).RightTree = lB End If Else 'If A was the whole tree's root, then it's role is taken over by B now. vBinTree(lB).Parent = sstNoParent lBinTreeRoot = lB End If 'New weights vBinTree(lA).RightHeight = vBinTree(lA).RightHeight - 2 vBinTree(lB).LeftHeight = vBinTree(lB).LeftHeight + 1 End Sub ' 'LR - C is the node that the rotation is performed on. This rotation is performed 'when C is unbalanced to the left (the left subtree is 2 higher than the right 'subtree), A is rightheavy (the right subtree of A is 1 higher than the left 'subtree of A) and B is leftheavy. T1, T2, T3, and T4 represent subtrees (a node 'was added to T2 which made B leftheavy, made A rightheavy and unbalanced C). 'This consists of a single left rotation at node A, followed by a single right 'at node C. P is C's parent and listed only because C's relationship with P is 'taken over by B, making relinks necessary. ' ' P P ' | | ' C B ' / \ ----------> / \ ' A T4 A C ' / \ / \ / \ ' T1 B T1 T2 T3 T4 ' / \ ** ' T2 T3 ' ** '+--+--------+--------+ '| | Before | After | '+--+--+--+--+--+--+--+ '| |LT|RT|PA|LT|RT|PA| '+--+--+--+--+--+--+--+ '|A | |B |C | |T2|B | '|B |T2|T3|A |A |C |P | '|C |A | |P |T3| |B | '|T2| | |B | | |A | '|T3| | |B | | |C | '|P | C | | B | | '+--+--+--+--+--+--+--+ ' Private Sub BalanceLR(lC As Long) Dim lA As Long Dim lB As Long Dim lT2 As Long Dim lT3 As Long Dim lP As Long 'Indices of old state lA = vBinTree(lC).LeftTree lB = vBinTree(lA).RightTree lP = vBinTree(lC).Parent lT2 = vBinTree(lB).LeftTree lT3 = vBinTree(lB).RightTree 'New links vBinTree(lA).RightTree = lT2 vBinTree(lA).Parent = lB vBinTree(lB).LeftTree = lA vBinTree(lB).RightTree = lC vBinTree(lC).LeftTree = lT3 vBinTree(lC).Parent = lB If lT2 <> sstNoChild Then vBinTree(lT2).Parent = lA If lT3 <> sstNoChild Then vBinTree(lT3).Parent = lC If lP <> sstNoParent Then 'C was either P's left or right child, B is taking that place now. vBinTree(lB).Parent = lP If vBinTree(lP).LeftTree = lC Then vBinTree(lP).LeftTree = lB Else vBinTree(lP).RightTree = lB End If Else 'If C was the whole tree's root, then it's role is taken over by B now. vBinTree(lB).Parent = sstNoParent lBinTreeRoot = lB End If 'New weights vBinTree(lA).RightHeight = vBinTree(lA).RightHeight - 1 vBinTree(lB).LeftHeight = vBinTree(lB).LeftHeight + 1 vBinTree(lB).RightHeight = vBinTree(lB).RightHeight + 1 vBinTree(lC).LeftHeight = vBinTree(lC).LeftHeight - 2 End Sub ' 'RL - A is the node that the rotation is performed on. This rotation is performed 'when A is unbalanced to the right (the right subtree is 2 higher than the left 'subtree), C is leftheavy (the left subtree of A is 1 higher than the right 'subtree of A) and B is rightheavy. T1, T2, T3, and T4 represent subtrees (a node 'was added to T3 which made B rightheavy, made C leftheavy and unbalanced A). 'This consists of a single right at node C, followed by a single left at node A. 'P is A's parent and listed only because A's relationship with P is taken over 'by B, making relinks necessary. ' ' P P ' | | ' A B ' / \ ----------> / \ ' T1 C A C ' / \ / \ / \ ' B T4 T1 T2 T3 T4 ' / \ ** ' T2 T3 ' ** '+--+--------+--------+ '| | Before | After | '+--+--+--+--+--+--+--+ '| |LT|RT|PA|LT|RT|PA| '+--+--+--+--+--+--+--+ '|A | |C |P | |T2|B | '|B |T2|T3|C |A |C |P | '|C |B | |A |T3| |B | '|T2| | |B | | |A | '|T3| | |B | | |C | '|P | A | | B | | '+--+--+--+--+--+--+--+ ' Private Sub BalanceRL(lA As Long) Dim lB As Long Dim lC As Long Dim lT2 As Long Dim lT3 As Long Dim lP As Long 'Indices of old state lP = vBinTree(lA).Parent lC = vBinTree(lA).RightTree lB = vBinTree(lC).LeftTree lT2 = vBinTree(lB).LeftTree lT3 = vBinTree(lB).RightTree 'New links vBinTree(lA).RightTree = lT2 vBinTree(lA).Parent = lB vBinTree(lB).LeftTree = lA vBinTree(lB).RightTree = lC vBinTree(lC).LeftTree = lT3 vBinTree(lC).Parent = lB If lT2 <> sstNoChild Then vBinTree(lT2).Parent = lA If lT3 <> sstNoChild Then vBinTree(lT3).Parent = lC If lP <> sstNoParent Then 'A was either P's left or right child, B is taking that place now. vBinTree(lB).Parent = lP If vBinTree(lP).LeftTree = lA Then vBinTree(lP).LeftTree = lB Else vBinTree(lP).RightTree = lB End If Else 'If A was the whole tree's root, then its role is taken over by B now. vBinTree(lB).Parent = sstNoParent lBinTreeRoot = lB End If 'New weights vBinTree(lA).RightHeight = vBinTree(lA).RightHeight - 2 vBinTree(lB).LeftHeight = vBinTree(lB).LeftHeight + 1 vBinTree(lB).RightHeight = vBinTree(lB).RightHeight + 1 vBinTree(lC).LeftHeight = vBinTree(lC).LeftHeight - 1 End Sub '_______________________________________________________________________________ 'Searching for a fast replacement of the slow StrComp. Private Function IStrComp(ByRef bStr() As Byte, ByRef bCmp() As Byte) As Long ' Dim lSameChars As Long ' '(As per MSDN October 2002, RTLCompareMemory() is only included in Win2K and XP.) 'Private Declare Function CompareMemory Lib "ntdll" Alias "RtlCompareMemory" _ ' (buffA As Any, buffB As Any, ByVal Length As Long) As Long ' 'CompareMemory returns how many byte elements are the same. ' lSameChars = CompareMemory(bStr(0), bCmp(0), UBound(bStr)) ' If bStr(lSameChars) > bCmp(lSameChars) Then ' IStrComp = sstKeyIsLarger ' Exit Function ' ElseIf bStr(lSameChars) < bCmp(lSameChars) Then ' IStrComp = sstKeyIsSmaller ' Exit Function ' End If ' 'Else returning 0 (doing nothing as it's the default result) Dim lPos As Long For lPos = 0 To UBound(bStr) Step 2& 'Step 2 for ANSI test, else 1 'bCmp might end sooner than bStr, but be otherwise equal. In this 'case bStr is larger. If lPos > UBound(bCmp) Then IStrComp = sstKeyIsSmaller Exit Function 'Instead of comparing each char twice (once for larger and once for 'smaller), we compare once for inequality. Only if not equal we do a 'final test on how it was not equal. ("<>" is faster than ">" or "<" 'alone, so even more when testing both.) ElseIf bStr(lPos) <> bCmp(lPos) Then If bStr(lPos) > bCmp(lPos) Then IStrComp = sstKeyIsLarger Else IStrComp = sstKeyIsSmaller End If Exit Function End If Next lPos 'Strings are equal if Cmp ends as well, or Cmp is longer and thus larger. If UBound(bStr) <> UBound(bCmp) Then IStrComp = sstKeyIsLarger 'Else implicitly returning sstKeyIsEqual = 0 End Function A C++ implementation // NOTE: All the member functions are inline in the following code. // This is not recommended. Only simple straight forward functions should be made inline. class AVLTree { private: class Node { private: int data; int height; Node * parent; Node * left_child; Node * right_child; public: Node(int val) { data = val; height = 0; parent = (Node*)0; left_child = (Node*)0; right_child = (Node*)0; } int getData() { return data; } int getHeight() { return height; } int updateHeight() { if(left_child != 0 && right_child != 0) { if(left_child->getHeight() > right_child->getHeight()) height = left_child->getHeight() + 1; else height = right_child->getHeight() + 1; } else if(left_child != 0) height = left_child->getHeight() + 1; else if(right_child != 0) height = right_child->getHeight() + 1; else height = 0; return height; } int getBalance() { Node * n = this; if(n->getLeftChild() != 0 && n->getRightChild() !=0) return n->getLeftChild()->getHeight() - n->getRightChild()->getHeight(); else if(n->getLeftChild() != 0) return n->getLeftChild()->getHeight() + 1; else if(n->getRightChild() != 0) return (-1) * (n->getRightChild()->getHeight() + 1); else return 0; } Node* getParent() { return parent; } void removeParent() { parent = (Node*)0; } Node* getLeftChild() { return left_child; } Node* setLeftChild(Node* new_left) { if(new_left != 0) new_left->parent = this; left_child = new_left; updateHeight(); return left_child; } Node* getRightChild() { return right_child; } Node* setRightChild(Node* new_right) { if(new_right != 0) new_right->parent = this; right_child = new_right; updateHeight(); return right_child; } }; void setRoot(Node* n) { root = n; if(root != 0) root->removeParent(); } Node* findNode(int val) { Node* temp = root; while(temp != 0) { if(val == temp->getData()) return temp; else if(val < temp->getData()) temp = temp->getLeftChild(); else temp = temp->getRightChild(); } return (Node*)0; } void rotateLeft(Node * n) { Node * p = n->getParent(); enum {left, right} side; if(p != 0) { if(p->getLeftChild() == n) side = left; else side = right; } Node * temp = n->getRightChild(); n->setRightChild(temp->getLeftChild()); temp->setLeftChild(n); // Now attach the subtree to the parent (or root) if(p != 0) { if(side == left) p->setLeftChild(temp); if(side == right) p->setRightChild(temp); } else { setRoot(temp); } } void rotateRight(Node * n) { Node * p = n->getParent(); enum {left, right} side; if(p != 0) { if(p->getLeftChild() == n) side = left; else side = right; } Node * temp = n->getLeftChild(); n->setLeftChild(temp->getRightChild()); temp->setRightChild(n); // Now attach the subtree to the parent (or root) if(p != 0) { if(side == left) p->setLeftChild(temp); if(side == right) p->setRightChild(temp); } else { setRoot(temp); } } // This function does balancing at the given node void balanceAtNode(Node* n) { int bal = n->getBalance(); if(bal > 1) { if(n->getLeftChild()->getBalance() < 0) rotateLeft(n->getLeftChild()); rotateRight(n); } else if(bal < -1) { if(n->getRightChild()->getBalance() > 0) rotateRight(n->getRightChild()); rotateLeft(n); } } Node * root; public: AVLTree() { root = (Node*)0; } AVLTree(int val) { root = new Node(val); } AVLTree * findSubtree(int val) { Node* target; target = findNode(val); if(target != 0) { AVLTree* subtree = new AVLTree(); subtree->root = target; return subtree; } else return (AVLTree*)0; } // Returns: // true: If addition is successful // false: If item already exists // bool insert(int val) { Node* added_node; if(root == 0) { root = new Node(val); } else { Node* temp = root; while(true) { if(temp->getData() > val) { if((temp->getLeftChild()) == 0) { added_node = temp->setLeftChild(new Node(val)); break; } else { temp = temp->getLeftChild(); } } else if(temp->getData() < val) { if((temp->getRightChild()) == 0) { added_node = temp->setRightChild(new Node(val)); break; } else { temp = temp->getRightChild(); } } else { return false; } } // The following code is for updating heights and balancing. temp = added_node; while(temp != 0) { temp->updateHeight(); balanceAtNode(temp); temp = temp->getParent(); } } return true; } // Returns: // true: If removal is successful // false: If item is not found in the tree // bool remove(int val) { if(root == 0) return false; Node *replacement, *replacement_parent, *temp_node; Node * to_be_removed = findNode(val); if(to_be_removed == 0) return false; Node * p = to_be_removed->getParent(); enum {left, right} side; if(p != 0) { if(p->getLeftChild() == to_be_removed) side = left; else side = right; } int bal = to_be_removed->getBalance(); if(to_be_removed->getLeftChild() == 0 && to_be_removed->getRightChild() == 0) { if(p != 0) { if(side == left) p->setLeftChild((Node*)0); else p->setRightChild((Node*)0); delete to_be_removed; p->updateHeight(); balanceAtNode(p); } else { setRoot((Node*)0); delete to_be_removed; } } else if(to_be_removed->getRightChild() == 0) { if(p != 0) { if(side == left) p->setLeftChild(to_be_removed->getLeftChild()); else p->setRightChild(to_be_removed->getLeftChild()); delete to_be_removed; p->updateHeight(); balanceAtNode(p); } else { setRoot(to_be_removed->getLeftChild()); delete to_be_removed; } } else if(to_be_removed->getLeftChild() == 0) { if(p != 0) { if(side == left) p->setLeftChild(to_be_removed->getRightChild()); else p->setRightChild(to_be_removed->getRightChild()); delete to_be_removed; p->updateHeight(); balanceAtNode(p); } else { setRoot(to_be_removed->getRightChild()); delete to_be_removed; } } else { if(bal > 0) { if(to_be_removed->getLeftChild()->getRightChild() == 0) { replacement = to_be_removed->getLeftChild(); replacement->setRightChild(to_be_removed->getRightChild()); temp_node = replacement; } else { replacement = to_be_removed->getLeftChild()->getRightChild(); while(replacement->getRightChild() != 0) { replacement = replacement->getRightChild(); } replacement_parent = replacement->getParent(); replacement_parent->setRightChild(replacement->getLeftChild()); temp_node = replacement_parent; replacement->setLeftChild(to_be_removed->getLeftChild()); replacement->setRightChild(to_be_removed->getRightChild()); } } else { if(to_be_removed->getRightChild()->getLeftChild() == 0) { replacement = to_be_removed->getRightChild(); replacement->setLeftChild(to_be_removed->getLeftChild()); temp_node = replacement; } else { replacement = to_be_removed->getRightChild()->getLeftChild(); while(replacement->getLeftChild() != 0) { replacement = replacement->getLeftChild(); } replacement_parent = replacement->getParent(); replacement_parent->setLeftChild(replacement->getRightChild()); temp_node = replacement_parent; replacement->setLeftChild(to_be_removed->getLeftChild()); replacement->setRightChild(to_be_removed->getRightChild()); } } if(p != 0) { if(side == left) p->setLeftChild(replacement); else p->setRightChild(replacement); delete to_be_removed; } else { setRoot(replacement); delete to_be_removed; } balanceAtNode(temp_node); } return true; } int getHeight() { return root->getHeight(); } };