Red Black Tree 'Class'
Posted: Mon Dec 20, 2004 12:17 am
Code updated For 5.20+
I have been struggling with this one for a little while now but I think I'm ready to upload the initial version. It needs a lot more bug testing and error checking code but from what I've tested, it works.
If you don't know what a Red/Black Tree is: ( http://en.wikipedia.org/wiki/Red_black_tree ) that should tell you. Basically it's a means of storing Key/Data pairs and retrieving the data value very quickly, based on it's key. The tree is balanced as new nodes are added and as they are deleted.
In testing it takes roughly 4.5 seconds to add 2,000,000 records and no time at all to find one based on it's key.
Anyhow, here's the first iteration of the code.
While I haven't tested it yet, duplicates should be okay based on the users discretion. I plan on adding a simple findfirst/next/previous/last function to iterate through any duplicates. Be warned that duplicates can throw the tree off balance and reduce it's efficiency.
What else? Hmmm.... documentation of the code is spotty at best and probably includes comments based on early code. The code could be updated but not the comments.
And, oh yes, it is very un-optimized and such. I'm always slightly embarassed posting my own code because of how childish it looks compared to a lot of the people here
But perhaps other people will find it useful for their own projects.
Enjoy and let me know if y'all find anything I should change or update. And if you update something to add functionality or increase efficiency how about letting us all know so we can update the code?
I have been struggling with this one for a little while now but I think I'm ready to upload the initial version. It needs a lot more bug testing and error checking code but from what I've tested, it works.
If you don't know what a Red/Black Tree is: ( http://en.wikipedia.org/wiki/Red_black_tree ) that should tell you. Basically it's a means of storing Key/Data pairs and retrieving the data value very quickly, based on it's key. The tree is balanced as new nodes are added and as they are deleted.
In testing it takes roughly 4.5 seconds to add 2,000,000 records and no time at all to find one based on it's key.
Anyhow, here's the first iteration of the code.
Code: Select all
;- Notes
; Borrowed heavily from 'Introduction To Algorithms 2nd Edition' by Cormen, Leiserson, et al.
;- Constants
#rbtEmpty = 0
#rbtRed = 1
#rbtBlack = 2
#rbtNull = -1
;- Structures
Structure s_rbtInfo
NodeCount.l
; A count of the nodes in the tree, including the root.
AllowDuplicates.b
; Whether or not we allow duplicate keys.
UpdateDuplicates.b
; If AllowDuplicates is False, this will control the behavior
; when a duplicate key is passed. When UpdateDuplicates is True
; we will replace the existing value with the passed value.
EndStructure
Structure s_RBT
Color.b ; 0 = tree is uninitialized, 1 = red, 2 = black, 3 = Null (a leaf)
Parent.l ; A pointer to our parent (if not root)
Left.l ; A pointer to our left child
Right.l ; A pointer to our right child
Key.l ; Our key (numeric)
Value.s ; The value to store.
Init.b ; Whether the Tree is initialized yet.
EndStructure
;- Private Procedures
Procedure.l rbt_AddNodeLeft(*Node.s_RBT, inKey.l, inValue.s) ; Creates a new Left Child for the *Node. Pass -1 key for a NIL leaf.
;
Protected *NewNode.s_RBT
Protected *rbtLeaf.s_RBT
;
*NewNode = AllocateMemory(SizeOf(s_RBT))
*NewNode\Parent = *Node
If inKey = -1
; A -1 indicates we're creating a Nil leaf.
*NewNode\Left = #rbtNull
*NewNode\Right = #rbtNull
*NewNode\Color = #rbtNull
Else
; Creating a non-leaf node.
*NewNode\Color = #rbtRed
*NewNode\Left = *Node\Left
;
*rbtLeaf = AllocateMemory(SizeOf(s_RBT))
*rbtLeaf\Color = #rbtNull
*rbtLeaf\Parent = *NewNode
*rbtLeaf\Right = #rbtNull
*rbtLeaf\Left = #rbtNull
*rbtLeaf\Key = -1
*rbtLeaf\Value = ""
;
*NewNode\Right = *rbtLeaf
;
EndIf
; If we aren't adding a new sentinel (Nil) node we need to take the Node's previous left child and set it to the new left child's
; left child.
*NewNode\Key = inKey
*NewNode\Value = inValue
;
*Node\Left = *NewNode
;
ProcedureReturn *NewNode
;
EndProcedure
Procedure.l rbt_AddNodeRight(*Node.s_RBT, inKey.l, inValue.s) ; Creates a new Right Child for the *Node. Pass -1 key for a NIL leaf.
;
Protected *rbtLeaf.s_RBT
Protected *NewNode.s_RBT
;
*NewNode = AllocateMemory(SizeOf(s_RBT))
*NewNode\Parent = *Node
;
If inKey = -1
*NewNode\Left = #rbtNull
*NewNode\Right = #rbtNull
; If we aren't adding a new sentinel (Nil) node we need to take the Node's previous right child and set it to the new right child's
; right child.
*NewNode\Color = #rbtNull
Else
*NewNode\Right = *Node\Right
; If we aren't adding a new sentinel (Nil) node we need to take the Node's previous right child and set it to the new right child's
; right child.
*NewNode\Color = #rbtRed
;
*rbtLeaf = AllocateMemory(SizeOf(s_RBT))
*rbtLeaf\Color = #rbtNull
*rbtLeaf\Parent = *NewNode
*rbtLeaf\Right = #rbtNull
*rbtLeaf\Left = #rbtNull
*rbtLeaf\Key = -1
*rbtLeaf\Value = ""
;
*NewNode\Left = *rbtLeaf
;
EndIf
;
*NewNode\Key = inKey
*NewNode\Value = inValue
;
*Node\Right = *NewNode
;
ProcedureReturn *NewNode
;
EndProcedure
Procedure.l rbt_Key(*Node.s_RBT) ; Return a Node's key based on it's address.
If *Node > 0 : ProcedureReturn *Node\Key : Else : ProcedureReturn 0 : EndIf
EndProcedure
Procedure.l rbt_Color(*Node.s_RBT) ; Return a Node's color based on it's address.
If *Node > 0 : ProcedureReturn *Node\Color : Else : ProcedureReturn 0 : EndIf
EndProcedure
Procedure rbt_SetColor(*Node.s_RBT, inColor.b) ; Return a Node's color based on it's address.
If *Node > 0 : *Node\Color = inColor : EndIf
EndProcedure
Procedure rbt_SetParent(*Node.s_RBT, Parent.l)
If *Node > 0 : *Node\Parent = Parent : EndIf
EndProcedure
Procedure rbt_SetLChild(*Node.s_RBT, LeftChild.l)
If *Node > 0 : *Node\Left = LeftChild : EndIf
EndProcedure
Procedure rbt_SetRChild(*Node.s_RBT, RightChild.l)
If *Node > 0 : *Node\Right = RightChild : EndIf
EndProcedure
Procedure rbt_SwapNodes(*Node01.s_RBT, *Node02.s_RBT) ; Swaps the key, color and value between two nodes.
Protected holdKey.l
Protected holdValue.s
Protected holdColor.b
If *Node01 > 0 And *Node02 > 0
holdKey = *Node01\Key
holdValue = *Node01\Value
holdColor = *Node01\Color
*Node01\Key = *Node02\Key
*Node01\Value = *Node02\Value
*Node01\Color = *Node02\Color
*Node02\Key = holdKey
*Node02\Value = holdValue
*Node02\Color = holdColor
EndIf
EndProcedure
Procedure.l rbt_Parent(*Node.s_RBT) ; Return the address of the parent of the Node.
If *Node > 0 : ProcedureReturn *Node\Parent : EndIf
EndProcedure
Procedure.l rbt_Left(*Node.s_RBT) ; Return the address of the left child of the Node.
If *Node > 0 : ProcedureReturn *Node\Left : EndIf
EndProcedure
Procedure.l rbt_Right(*Node.s_RBT) ; Return the address of the right child of the Node.
If *Node > 0 : ProcedureReturn *Node\Right : EndIf
EndProcedure
Procedure rbt_RotateLeft(*Node.s_RBT, *Root.s_RBT)
;
Protected lHold.l
Protected *Child.s_RBT
;
*Child = *Node\Right
;
If *Node = *Root
; We rotated our root. Since we reference the whole tree by the root address, we can't simply attach
; the root to it's child node for the rotation. This would cause us to falsely reference the old root.
lHold = *Node\Left
*Node\Left = *Child\Left
rbt_SetParent(*Child\Left, *Node)
*Child\Left = lHold
rbt_SetParent(lHold, *Child)
;
*Node\Right = *Child\Right
rbt_SetParent(*Child\Right, *Node)
*Child\Right = *Node
*Child\Parent = *Node\Parent
*Node\Parent = *Child
;
rbt_SwapNodes(*Node, *Child)
;
*Node = *Node\Parent
*Child = *Node\Right
;
EndIf
;
lHold = *Child\Left
*Child\Left = *Node
*Node\Right = lHold
;
*Child\Parent = *Node\Parent
If *Child <> *Root
If rbt_Right(*Node\Parent) = *Node
rbt_SetRChild(*Node\Parent, *Child)
Else
rbt_SetLChild(*Node\Parent, *Child)
EndIf
EndIf
*Node\Parent = *Child
rbt_SetParent(lHold, *Node)
;
EndProcedure
Procedure rbt_RotateRight(*Node.s_RBT, *Root.s_RBT)
;
Protected lHold.l
Protected *Child.s_RBT
;
*Child = *Node\Left
;
If *Node = *Root
; We rotated our root. Since we reference the whole tree by the root address, we can't simply attach
; the root to it's child node for the rotation. This would cause us to falsely reference the old root.
lHold = *Node\Right
*Node\Right = *Child\Right
rbt_SetParent(*Child\Right, *Node)
*Child\Right = lHold
rbt_SetParent(lHold, *Child)
;
*Node\Left = *Child\Left
rbt_SetParent(*Child\Left, *Node)
*Child\Left = *Node
*Child\Parent = *Node\Parent
*Node\Parent = *Child
;
rbt_SwapNodes(*Node, *Child)
;
*Node = *Node\Parent
*Child = *Node\Left
;
EndIf
;
lHold = *Child\Right
*Child\Right = *Node
*Node\Left = lHold
;
*Child\Parent = *Node\Parent
If *Child <> *Root
If rbt_Left(*Node\Parent) = *Node
rbt_SetLChild(*Node\Parent, *Child)
Else
rbt_SetRChild(*Node\Parent, *Child)
EndIf
EndIf
*Node\Parent = *Child
rbt_SetParent(lHold, *Node)
;
EndProcedure
Procedure rbt_BalanceInsert(*z.s_RBT, *Root.s_RBT)
;
Protected *pz.s_RBT
Protected *y.s_RBT
;
*pz = *z\Parent
;
While *pz\Color = #rbtRed
If *pz = rbt_Left(*pz\Parent)
; Our parent is the left child of it's parent.
*y = rbt_Right(*pz\Parent)
If *y\Color = #rbtRed
*pz\Color = #rbtBlack
*y\Color = #rbtBlack
rbt_SetColor(*pz\Parent, #rbtRed)
*z = *pz\Parent
Else
If *z = *pz\Right
*z = *pz
rbt_RotateLeft(*z, *Root)
*pz = *z\Parent
EndIf
*pz\Color = #rbtBlack
rbt_SetColor(*pz\Parent, #rbtRed)
rbt_RotateRight(*pz\Parent, *Root)
EndIf
Else
; Our parent is the right child of it's parent.
*y = rbt_Left(*pz\Parent)
If *y\Color = #rbtRed
*pz\Color = #rbtBlack
*y\Color = #rbtBlack
rbt_SetColor(*pz\Parent, #rbtRed)
*z = *pz\Parent
Else
If *z = *pz\Left
*z = *pz
rbt_RotateRight(*z, *Root)
*pz = *z\Parent
EndIf
*pz\Color = #rbtBlack
rbt_SetColor(*pz\Parent, #rbtRed)
rbt_RotateLeft(*pz\Parent, *Root)
EndIf
EndIf
*pz = *z\Parent
Wend
;
*Root\Color = #rbtBlack
;
EndProcedure
Procedure.l rbt_Insert(*Node.s_RBT, inKey.l, inValue.s) ; A private function to insert a key into the tree.
;
Protected *rbtInfo.s_rbtInfo
;
*rbtInfo = *Node\Parent
;
Repeat
;
If inKey <= *Node\Key
;
If *Node\Key = inKey
; We found a matching key. Check to see if we're allowing duplicate keys first.
If *rbtInfo\AllowDuplicates = #False
; Guardian routine to see if we're allowing for duplicates.
If *rbtInfo\UpdateDuplicates = #True
; Allowing updates to duplicate keys.
ProcedureReturn *Node
; We are going to replace the value with the passed value. Pass the address of the node to be replaced.
Else
ProcedureReturn -1
; We aren't allowing duplicates and we aren't replacing them so don't add this key.
EndIf
EndIf
EndIf
; If we made it this far then we've either got a duplicate key that we're allowing or we have a non-duplicate key.
If rbt_Color(*Node\Left) = #rbtNull
; Left child is a leaf - Null value so add it here.
ProcedureReturn rbt_AddNodeLeft(*Node, inKey, inValue)
; Return the address of the new node.
Else
*Node = *Node\Left
; Not a leaf, keep checking by descending the left child.
EndIf
;
Else
If rbt_Color(*Node\Right) = #rbtNull
; Right child is a leaf - Null value so add it here.
ProcedureReturn rbt_AddNodeRight(*Node, inKey, inValue)
; Return the address of the new node.
Else
*Node = *Node\Right
; Not a leaf, keep checking by descending the right child.
EndIf
EndIf
ForEver
;
ProcedureReturn -1
; If we got to this point then we couldn't add it. Should be because of a Duplicate/Denied addition.
EndProcedure
Procedure.s rbt_Find(*Node.s_RBT, inKey.l) ; A private function to return a value based on it's key.
Repeat
If *Node\Key = inKey
ProcedureReturn *Node\Value
Else
If inKey <= *Node\Key
*Node = *Node\Left
Else
*Node = *Node\Right
EndIf
EndIf
Until *Node\Color = #rbtNull
; Will never match against a Nil leaf since we move nodes and then check this condition.
ProcedureReturn ""
EndProcedure
Procedure.l rbt_Locate(*Node.s_RBT, inKey.l) ; Returns the node address based on it's key and -1 if it does not exist.
Repeat
If *Node\Key = inKey
ProcedureReturn *Node
Else
If inKey <= *Node\Key
*Node = *Node\Left
Else
*Node = *Node\Right
EndIf
EndIf
Until *Node\Color = #rbtNull
; Will never return a Nil leaf since we change nodes right before checking this.
ProcedureReturn -1
EndProcedure
Procedure.l rbt_Min(*Node.s_RBT) ; Returns the node of the lowest key at the starting node.
If rbt_Color(*Node\Left) = #rbtNull
ProcedureReturn *Node
Else
Repeat
*Node = *Node\Left
Until rbt_Color(*Node\Left) = #rbtNull
EndIf
ProcedureReturn *Node
EndProcedure
Procedure.l rbt_Max(*Node.s_RBT) ; Returns the node of the highest key at the starting node.
If rbt_Color(*Node\Right) = #rbtNull
ProcedureReturn *Node
Else
Repeat
*Node = *Node\Right
Until rbt_Color(*Node\Right) = #rbtNull
EndIf
ProcedureReturn *Node
EndProcedure
Procedure.l rbt_Successor(*Node.s_RBT)
Protected *rbtHold.s_RBT
If rbt_Color(*Node\Right) <> #rbtNull
ProcedureReturn rbt_Min(*Node\Right)
Else
*rbtHold = *Node\Parent
While *rbtHold\Color <> #rbtEmpty And *Node = *rbtHold\Right
*Node = *rbtHold
*rbtHold = *Node\Parent
Wend
; Return the ancestor.
ProcedureReturn *rbtHold
EndIf
EndProcedure
Procedure.l rbt_Predeccessor(*Node.s_RBT)
Protected *rbtHold.s_RBT
If rbt_Color(*Node\Left) <> #rbtNull
ProcedureReturn rbt_Max(*Node\Left)
Else
*rbtHold = *Node\Parent
While *rbtHold\Color <> #rbtEmpty And *Node = *rbtHold\Left
*Node = *rbtHold
*rbtHold = *Node\Parent
Wend
; Return the ancestor.
ProcedureReturn *rbtHold
EndIf
EndProcedure
Procedure rbt_BalanceDelete(*x.s_RBT, *Root.s_RBT) ; A private function to clean up after deleting a black node.
;
Protected *px.s_RBT
Protected *w.s_RBT
;
While *x <> *Root And (*x\Color = #rbtBlack Or *x\Color = #rbtNull)
*px = *x\Parent
If *px\Left = *x
; X is the left child of it's parent.
*w = *px\Right
If *w\Color = #rbtRed
*w\Color = #rbtBlack
*px\Color = #rbtRed
rbt_RotateLeft(*px, *Root)
*w = *px\Right
EndIf
If (rbt_Color(*w\Left) = #rbtBlack Or rbt_Color(*w\Left) = #rbtNull) And (rbt_Color(*w\Right) = #rbtBlack Or rbt_Color(*w\Right) = #rbtNull)
*w\Color = #rbtRed
*x = *px
Else
If rbt_Color(*w\Right) = #rbtBlack Or rbt_Color(*w\Right) = #rbtNull
rbt_SetColor(*w\Left, #rbtBlack) ; Check to see if a Null check is required.
*w\Color = #rbtRed
rbt_RotateRight(*w, *Root)
*w = rbt_Right(*px)
EndIf
*w\Color = *px\Color
*px\Color = #rbtBlack
rbt_SetColor(*w\Right, #rbtBlack) ; Check to see if a Null check is required.
rbt_RotateLeft(*px, *Root)
*w = *px\Right
*x = *Root
EndIf
Else
; X is the right child of it's parent.
*w = *px\Left
If *w\Color = #rbtRed
*w\Color = #rbtBlack
*px\Color = #rbtRed
rbt_RotateRight(*px, *Root)
*w = *px\Left
EndIf
If (rbt_Color(*w\Left) = #rbtBlack Or rbt_Color(*w\Left) = #rbtNull) And (rbt_Color(*w\Right) = #rbtBlack Or rbt_Color(*w\Right) = #rbtNull)
*w\Color = #rbtRed
*x = *px
Else
If rbt_Color(*w\Left) = #rbtBlack Or rbt_Color(*w\Left) = #rbtNull
rbt_SetColor(*w\Right, #rbtBlack) ; Check to see if a Null check is required.
*w\Color = #rbtRed
rbt_RotateLeft(*w, *Root)
*w = rbt_Left(*px)
EndIf
*w\Color = *px\Color
*px\Color = #rbtBlack
rbt_SetColor(*w\Left, #rbtBlack) ; Check to see if a Null check is required.
rbt_RotateRight(*px, *Root)
*w = *px\Left
*x = *Root
EndIf
EndIf
Wend
;
*x\Color = #rbtBlack
;
EndProcedure
;- Debug Procedures
Procedure rbt_DestroyDebug(*Node.s_RBT) ; Called to completely destroy our tree.
;
Protected lHold.l
Protected ChildPath.b
Protected *Root.s_RBT
Protected *Parent.s_RBT
;
; Debug " "
; Debug " **** Destroying the tree ("+Str(*Node\Key)+")"
; Debug " "
*Root = *Node
; Hold our root node address for testing.
Repeat
;
If *Node = *Root
; We're at the root.
; Debug "At the root ("+Str(*Node\Key)+") with Children ("+Str(rbt_Key(*Node\Left))+", "+Str(*Node\Left)+", "+Str(rbt_Init(*Node\Left))+") And ("+Str(rbt_Key(*Node\Right))+", "+Str(*Node\Right)+", "+Str(rbt_Init(*Node\Right))+")."
If rbt_Color(*Node\Left) = #rbtNull
; No left children for the root.
If rbt_Color(*Node\Right) = #rbtNull
; Debug "Destroying the root."
; And no right children either. We're done.
Debug "Burning the root's right child ("+Str(rbt_Key(*Node\Right))+", "+Str(*Node\Right)+")."
FreeMemory(*Node\Right)
Debug "Burning the root's left child ("+Str(rbt_Key(*Node\Left))+", "+Str(*Node\Left)+")."
FreeMemory(*Node\Left)
; Have to free the sentinel nodes
Debug "Burning the informational structure."
FreeMemory(*Node\Parent)
; Free our informational structure.
Debug "Burning the root ("+Str(*Node\Key)+", "+Str(*Node)+")."
FreeMemory(*Node)
*Node = #rbtNull
; We should be totally done - kill the root and exit.
Else
; Still a right child left
ChildPath = 2
*Node = *Node\Right
*Parent = *Node\Parent
; Debug "Descending right ("+Str(*Node\Key)+", "+Str(*Parent\Key)+")"
EndIf
Else
; Still a left child left.
ChildPath = 1
*Node = *Node\Left
*Parent = *Node\Parent
; Debug "Descending left ("+Str(*Node\Key)+", "+Str(*Parent\Key)+")"
EndIf
Else
; *Parent = *Node\Parent
; Not at the root.
; Debug "Not at root ("+Str(*Node\Key)+", "+Str(*Parent\Key)+")"
If rbt_Color(*Node\Left) = #rbtNull
; No more left children
If rbt_Color(*Node\Right) = #rbtNull
; Debug "No left or right child exist ("+Str(*Node\Left)+", "+Str(*Node\Right)+")."
; No more right children or left children. Free the current element and our procedure should go back to the previous element.
If *Parent\Left = *Node
; This was a left child
*Parent\Left = *Node\Left
; Copy the Node's left Nil leaf to take the Node's place. This way our routine will see that the Parent node has a Nil
; left child and won't traverse that path.
rbt_SetParent(*Node\Left, *Parent)
; Debug "Moving "+Str(*Node\Left)+" to "+Str(*Parent\Key)+"'s left child."
;
ChildPath = 1
;
; Debug "Burning ("+Str(*Node\Key)+")'s Right child ("+Str(rbt_Key(*Node\Right))+", "+Str(*Node\Right)+")."
FreeMemory(*Node\Right)
; Free up the right leaf (Nil node) since we're moving the left one up to the parent to take Node's place.
If *Node\Color = #rbtRed
; Debug "Burning ("+Str(*Node\Key)+", "+Str(*Node)+") which is a Left child of ("+Str(*Parent\Key)+") And colored RED."
Debug Str(*Node\Key)+",L,"+Str(*Parent\Key)+",RED"
Else
; Debug "Burning ("+Str(*Node\Key)+", "+Str(*Node)+") which is a Left child of ("+Str(*Parent\Key)+") And colored BLACK."
Debug Str(*Node\Key)+",L,"+Str(*Parent\Key)+",BLACK"
EndIf
Else
; This was a right child
*Parent\Right = *Node\Right
; Copy the Node's right Nil leaf to take the Node's place. This way our routine will see that the Parent node has a Nil
; right child and won't traverse that path.
rbt_SetParent(*Node\Right, *Parent)
; Debug "Moving "+Str(*Node\Right)+" to "+Str(*Parent\Key)+"'s right child."
;
ChildPath = 2
; Debug "Burning ("+Str(*Node\Key)+")'s left child ("+Str(rbt_Key(*Node\Left))+", "+Str(*Node\Left)+")."
FreeMemory(*Node\Left)
; Free up the left leaf (Nil node) since we're moving the right one up to the parent to take Node's place.
If *Node\Color = #rbtRed
; Debug "Burning ("+Str(*Node\Key)+", "+Str(*Node)+") which is a Right child of ("+Str(*Parent\Key)+") And colored RED."
Debug Str(*Node\Key)+",R,"+Str(*Parent\Key)+",RED"
Else
; Debug "Burning ("+Str(*Node\Key)+", "+Str(*Node)+") which is a Right child of ("+Str(*Parent\Key)+") And colored BLACK."
Debug Str(*Node\Key)+",R,"+Str(*Parent\Key)+",BLACK"
EndIf
EndIf
;
; Kill our leaves for this node.
lHold = *Node
*Node = *Node\Parent
*Parent = *Node\Parent
;lCount + 1
FreeMemory(lHold)
;
Else
; There are still right children left.
ChildPath = 2
*Node = *Node\Right
*Parent = *Node\Parent
; Debug "Descending right ("+Str(*Node\Key)+", "+Str(*Parent\Key)+")"
EndIf
Else
; Still left children left.
ChildPath = 1
*Node = *Node\Left
*Parent = *Node\Parent
; Debug "Descending left ("+Str(*Node\Key)+", "+Str(*Parent\Key)+")"
EndIf
;
EndIf
;
Until *Node = #rbtNull
;
EndProcedure
Procedure rbt_BalanceDeleteDebug(*x.s_RBT, *Root.s_RBT) ; A private function to clean up after deleting a black node.
;
Protected *px.s_RBT
Protected *w.s_RBT
;
Debug " ---- Begin Delete Balance"
Debug "X is: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
;While rbt_Parent(*x) <> *Root And (*x\Color = #rbtBlack Or *x\Color = #rbtNull)
While *x <> *Root And (*x\Color = #rbtBlack Or *x\Color = #rbtNull)
*px = *x\Parent
Debug "px is: "+Str(*px\Key)+" and colored: "+Str(*px\Color)
If *px\Left = *x
; X is the left child of it's parent.
Debug "X is the left child of it's parent."
*w = *px\Right
Debug "W is: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
If *w\Color = #rbtRed
Debug "Case 1 Active - W is red."
;/ Case 1
*w\Color = #rbtBlack
Debug "Setting w("+Str(*w\Key)+") to Black."
*px\Color = #rbtRed
Debug "Setting px("+Str(*px\Key)+") to Red."
Debug "Rotating ("+Str(*px\Key)+") Left."
rbt_RotateLeft(*px, *Root)
Debug "x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Debug "px is now: "+Str(*px\Key)+" and colored: "+Str(*px\Color)
*w = *px\Right
Debug "Setting W to px's right child. W is now: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
EndIf
If (rbt_Color(*w\Left) = #rbtBlack Or rbt_Color(*w\Left) = #rbtNull) And (rbt_Color(*w\Right) = #rbtBlack Or rbt_Color(*w\Right) = #rbtNull)
Debug "Case 2 is Active. Both of W's children are Black."
;/ Case 2
*w\Color = #rbtRed
Debug "Setting w("+Str(*w\Key)+") to Red."
*x = *px
Debug "Setting x to px. x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Else
If rbt_Color(*w\Right) = #rbtBlack Or rbt_Color(*w\Right) = #rbtNull
Debug "Case 3 is Active. Left child of W is Red, Right Child is Black."
;/ Case 3
rbt_SetColor(*w\Left, #rbtBlack) ; Check to see if a Null check is required.
Debug "w's left child ("+Str(rbt_Key(*w\Right))+") is now colored Black."
*w\Color = #rbtRed
Debug "Setting w("+Str(*w\Key)+") to Red."
Debug "Rotating ("+Str(*w\Key)+") Right."
rbt_RotateRight(*w, *Root)
Debug "x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Debug "px is now: "+Str(*px\Key)+" and colored: "+Str(*px\Color)
*w = rbt_Right(*px)
Debug "Setting W to px's right child. W is now: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
EndIf
;/ Case 4
*w\Color = *px\Color
Debug "Setting w("+Str(*w\Key)+") to px's ("+Str(*px\Key)+") color ("+Str(*px\Color)+")."
*px\Color = #rbtBlack
Debug "Setting px("+Str(*px\Key)+") to Black."
rbt_SetColor(*w\Right, #rbtBlack) ; Check to see if a Null check is required.
Debug "Setting w's right child("+Str(rbt_Key(*w\Left))+") to Black."
Debug "Rotating ("+Str(*px\Key)+") Left."
rbt_RotateLeft(*px, *Root)
Debug "x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Debug "px is now: "+Str(*px\Key)+" and colored: "+Str(*px\Color)
*w = *px\Right
Debug "w is now: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
Debug "w left child is now: "+Str(rbt_Key(*w\Left))+" and colored: "+Str(rbt_Color(*w\Left))
Debug "w right child is now: "+Str(rbt_Key(*w\Right))+" and colored: "+Str(rbt_Color(*w\Right))
*x = *Root
Debug "Setting *x to *Root. Exit."
EndIf
Else
; X is the right child of it's parent.
*w = *px\Left
Debug "W is: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
If *w\Color = #rbtRed
Debug "Case 1 Active - W is red."
;/ Case 1
*w\Color = #rbtBlack
Debug "Setting w("+Str(*w\Key)+") to Black."
*px\Color = #rbtRed
Debug "Setting px("+Str(*px\Key)+") to Red."
Debug "Rotating ("+Str(*px\Key)+") Right."
rbt_RotateRight(*px, *Root)
Debug "x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Debug "px is now: "+Str(*px\Key)+" and colored: "+Str(*px\Color)
*w = *px\Left
Debug "Setting W to px's left child. W is now: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
EndIf
If (rbt_Color(*w\Left) = #rbtBlack Or rbt_Color(*w\Left) = #rbtNull) And (rbt_Color(*w\Right) = #rbtBlack Or rbt_Color(*w\Right) = #rbtNull)
Debug "Case 2 is Active. Both of W's children are Black."
;/ Case 2
*w\Color = #rbtRed
Debug "Setting w("+Str(*w\Key)+") to Red."
*x = *px
Debug "Setting x to px. x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Else
If rbt_Color(*w\Left) = #rbtBlack Or rbt_Color(*w\Left) = #rbtNull
Debug "Case 3 is Active. Right child of W is Red, Left Child is Black."
;/ Case 3
rbt_SetColor(*w\Right, #rbtBlack) ; Check to see if a Null check is required.
Debug "w's right child ("+Str(rbt_Key(*w\Right))+") is now colored Black."
*w\Color = #rbtRed
Debug "Setting w("+Str(*w\Key)+") to Red."
Debug "Rotating ("+Str(*w\Key)+") Left."
rbt_RotateLeft(*w, *Root)
Debug "x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Debug "px is now: "+Str(*px\Key)+" and colored: "+Str(*px\Color)
*w = rbt_Left(*px)
Debug "Setting W to px's left child. W is now: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
EndIf
;/ Case 4
*w\Color = *px\Color
Debug "Setting w("+Str(*w\Key)+") to px's ("+Str(*px\Key)+") color ("+Str(*px\Color)+")."
*px\Color = #rbtBlack
Debug "Setting px("+Str(*px\Key)+") to Black."
rbt_SetColor(*w\Left, #rbtBlack) ; Check to see if a Null check is required.
Debug "Setting w's left child("+Str(rbt_Key(*w\Left))+") to Black."
Debug "Rotating ("+Str(*px\Key)+") Right."
rbt_RotateRight(*px, *Root)
Debug "x is now: "+Str(*x\Key)+" and colored: "+Str(*x\Color)
Debug "px is now: "+Str(*px\Key)+" and colored: "+Str(*px\Color)
*w = *px\Left
Debug "w is now: "+Str(*w\Key)+" and colored: "+Str(*w\Color)
Debug "w left child is now: "+Str(rbt_Key(*w\Left))+" and colored: "+Str(rbt_Color(*w\Left))
Debug "w right child is now: "+Str(rbt_Key(*w\Right))+" and colored: "+Str(rbt_Color(*w\Right))
*x = *Root
Debug "Setting *x to *Root. Exit."
EndIf
EndIf
Wend
;
*x\Color = #rbtBlack
Debug "Setting x("+Str(*x\Key)+") to Black."
Debug " *********** FINISHED BALANCE DELETE ************"
;
EndProcedure
Procedure rbt_DeleteDebug(*Root.s_RBT, inKey.l) ; Called to delete a node from our tree.
;
Protected *rbtInfo.s_rbtInfo
;
Protected *z.s_RBT
Protected *x.s_RBT
Protected *y.s_RBT
;
*rbtInfo = *Root\Parent
; Our information structure for the tree.
*z = rbt_Locate(*Root, inKey)
; Get the address for the node to delete. Start with the real root.
If *z = -1 : ProcedureReturn : EndIf
; If *z is -1, we didn't find the node to delete. Exit.
If rbt_Color(*z\Left) = #rbtNull Or rbt_Color(*z\Right) = #rbtNull
*y = *z
Debug "The node to delete had at least one leaf. Copy the Node-To-Delete to our Y pointer."
Else
*y = rbt_Successor(*z)
If *y\Color = #rbtBlack And rbt_Color(*y\Left) = #rbtNull And rbt_Color(*y\Right) = #rbtNull : *y = rbt_Predeccessor(*z) : EndIf
Debug "The node to delete had two non-leaf children. Search for the node to swap. Found: '"+Str(*y\Key)+"'"
EndIf
;
If rbt_Color(*y\Left) <> #rbtNull
*x = *y\Left
Debug "Y's left child is not null. Setting X to Y's left child '"+Str(*x\Key)+"'"
Else
*x = *y\Right
If *x\Color = #rbtNull
Debug "Y's right child is Nil."
Else
Debug "Y's right child is not null. Setting X to Y's right child '"+Str(*x\Key)+"'"
EndIf
EndIf
;
*x\Parent = *y\Parent
; Set the right child of the node to delete's parent to the node's parent.
If *y\Parent = *rbtInfo
; This will be triggered if Y is the root. It's parent is the information structure.
; root[T] = *x
; I think it's saying that if Y's Parent is NIL (which makes Y the root) then we copy X into the root node, making it the new root instead of Y.
Else
If *y = rbt_Left(*y\Parent)
rbt_SetLChild(*y\Parent, *x)
Debug "Y was the left child of it's parent. Setting Y's parent's left child to X."
Else
rbt_SetRChild(*y\Parent, *x)
Debug "Y was the right child of it's parent. Setting Y's parent's right child to X."
EndIf
EndIf
;
If *y <> *z
Debug "We are not removing the node-to-delete. Copy the successor node '"+Str(*y\Key)+"' into our original node '"+Str(*z\Key)+"'"
; This happens only if the node to delete had two non-leaf children. If that happened, we searched for a successor to swap
; with our node-to-delete.
*z\Key = *y\Key
*z\Value = *y\Value
; Copy *y (key & value) into *z
EndIf
;
If *y\Color = #rbtBlack Or *y\Color = #rbtNull
Debug Str(*y\Key)+" is Black. Removing it and calling our balancing function with '"+Str(*x\Key)+"'"
FreeMemory(*y)
; Remove our node from memory. Call this after checking it's color.
rbt_BalanceDelete(*x, *Root)
; Balance our tree after deleting the node.
Else
Debug Str(*y\Key)+" is Red. Removing and exiting."
; Red node, no need to call our balancing function. Just remove the node.
FreeMemory(*y)
EndIf
;
*rbtInfo\NodeCount - 1
; Decrement our node count.
EndProcedure
;- Procedures
Procedure.l rbtCreate() ; Create the initial tree. Always call this first and pass it's result to the other functions.
;
Protected *Tree.s_RBT
Protected *rbtInfo.s_rbtInfo
;
*Tree = AllocateMemory(SizeOf(s_RBT))
*Tree\Color = #rbtEmpty
; Our root is always black but we haven't added any nodes yet so
; make it empty first. When we add a node we'll check this and
; set the new node as the root.
*rbtInfo = AllocateMemory(SizeOf(s_rbtInfo))
; The fake root will not point to a parent node but will instead
; point to our information structure. We'll use this to access
; optional parameters within the tree.
*Tree\Parent = *rbtInfo
; Our root should always point to the informational structure.
*rbtInfo\NodeCount = 0
; No nodes yet.
*rbtInfo\AllowDuplicates = #False
*rbtInfo\UpdateDuplicates = #False
; Set the defaults for our information structure.
*Tree\Left = rbt_AddNodeLeft(*Tree, -1, "")
; Add our Nil left leaf.
*Tree\Right = rbt_AddNodeRight(*Tree, -1, "")
; Add our Nil right leaf.
*Tree\Init = #True
;
ProcedureReturn *Tree
; Return the address of the root node.
EndProcedure
Procedure rbtAllowDuplicates(*Root.s_RBT, AllowDuplicates.b)
; Used to allow or deny duplicate keys. Be careful when
; using this. Duplicate keys are <= to the matching node
; so will get added to the left child. Add too many of these
; and you'll get an unbalanced tree. Possible to look into
; a routine to randomly pick a left or right child for the
; duplicate key.
; Usage:
; q.l
; q = rbtCreate()
; rbtAllowDuplicates(q, #True) ; or rbtAllowDuplicates(q, #False)
;
Protected *rbtInfo.s_rbtInfo
*rbtInfo = *Root\Parent
*rbtInfo\AllowDuplicates = AllowDuplicates
;
EndProcedure
Procedure rbtUpdateDuplicates(*Root.s_RBT, UpdateDuplicates.b)
; Used to set whether adding a duplicate value only updates
; the existing node or replaces it. This is only checked if
; AllowDuplicates is True. If AllowDuplicates is True and
; UpdateDuplicates is True, any duplicate keys that are added
; will instead replace the existing node. If False, the
; duplicate key will be rejected.
; Usage:
; q.l
; q = rbtCreate()
; rbtUpdateDuplicates(q, #True) ; or rbtUpdateDuplicates(q, #False)
;
Protected *rbtInfo.s_rbtInfo
*rbtInfo = *Root\Parent
*rbtInfo\UpdateDuplicates = UpdateDuplicates
EndProcedure
Procedure.l rbtCount(*Root.s_RBT) ; Returns the number of nodes in a red-black tree, including the root.
;
; Usage:
;
; q.l = rbtCreate()
; Debug rbtCount(q)
;
Protected *rbtInfo.s_rbtInfo
*rbtInfo = *Root\Parent
ProcedureReturn *rbtInfo\NodeCount
;
EndProcedure
Procedure rbtDestroy(*Node.s_RBT) ; Called to completely destroy our tree.
;
Protected lHold.l
Protected ChildPath.b
Protected *Root.s_RBT
Protected *Parent.s_RBT
;
*Root = *Node
; Hold our root node address for testing.
Repeat
;
If *Node = *Root
; We're at the root.
If rbt_Color(*Node\Left) = #rbtNull
; No left children for the root.
If rbt_Color(*Node\Right) = #rbtNull
; And no right children either. We're done.
FreeMemory(*Node\Right)
FreeMemory(*Node\Left)
; Have to free the sentinel nodes
FreeMemory(*Node\Parent)
; Free our informational structure.
FreeMemory(*Node)
*Node = #rbtNull
; We should be totally done - kill the root and exit.
Else
; Still a right child left
ChildPath = 2
*Node = *Node\Right
*Parent = *Node\Parent
EndIf
Else
; Still a left child left.
ChildPath = 1
*Node = *Node\Left
*Parent = *Node\Parent
EndIf
Else
; Not at the root.
If rbt_Color(*Node\Left) = #rbtNull
; No more left children
If rbt_Color(*Node\Right) = #rbtNull
; No more right children or left children. Free the current element and our procedure should go back to the previous element.
If *Parent\Left = *Node
; This was a left child
*Parent\Left = *Node\Left
; Copy the Node's left Nil leaf to take the Node's place. This way our routine will see that the Parent node has a Nil
; left child and won't traverse that path.
rbt_SetParent(*Node\Left, *Parent)
;
ChildPath = 1
;
FreeMemory(*Node\Right)
; Free up the right leaf (Nil node) since we're moving the left one up to the parent to take Node's place.
Else
; This was a right child
*Parent\Right = *Node\Right
; Copy the Node's right Nil leaf to take the Node's place. This way our routine will see that the Parent node has a Nil
; right child and won't traverse that path.
rbt_SetParent(*Node\Right, *Parent)
;
ChildPath = 2
FreeMemory(*Node\Left)
; Free up the left leaf (Nil node) since we're moving the right one up to the parent to take Node's place.
EndIf
;
; Kill our leaves for this node.
lHold = *Node
*Node = *Node\Parent
*Parent = *Node\Parent
;lCount + 1
FreeMemory(lHold)
;
Else
; There are still right children left.
ChildPath = 2
*Node = *Node\Right
*Parent = *Node\Parent
EndIf
Else
; Still left children left.
ChildPath = 1
*Node = *Node\Left
*Parent = *Node\Parent
EndIf
;
EndIf
;
Until *Node = #rbtNull
;
EndProcedure
Procedure.l rbtAdd(*Root.s_RBT, inKey.l, inValue.s) ; Called to add a new key/value pair to our tree.
;
Protected *Node.s_RBT
Protected *rbtInfo.s_rbtInfo
;
lHold.l
;
*rbtInfo = *Root\Parent
;
If *Root\Init
;
If *Root\Color = #rbtEmpty
; If our root node is colored 'Empty', it is uninitialized. Our new node will go here.
*Root\Color = #rbtBlack
; The root is always black.
*Root\Key = inKey
; Set our key...
*Root\Value = inValue
; ...and our value.
*rbtInfo\NodeCount = 1
; And now we've inserted the root node so we have 1 node.
Else
; Tree is already initialized so add a new element somewhere.
iHold = rbt_Insert(*Root, inKey, inValue)
; Start our insertion routine with the address of the root element.
If iHold <> -1
; Return -1 if we did not insert our node.
*rbtInfo\NodeCount + 1
; Increase our node count.
rbt_BalanceInsert(iHold, *Root)
; Now balance our newly inserted item if it needs to be balanced.
ProcedureReturn iHold
;
EndIf
EndIf
;
EndIf
;
EndProcedure
Procedure.l rbtMinimum(*NodeAddress.s_RBT) ; Returns the node of the lowest key at the starting node.
;
; Usage:
;
; q.l = rbtCreate()
; rbtAdd(q, 9, "")
; rbtAdd(q, 5, "")
; rbtAdd(q, 4, "")
; rbtAdd(q, 10, "")
; ; 5
; ; 4 9
; ; 10
; Debug rbtMinimum(q) ; Will return '4'
; t.l = rbtIndex(q, 9)
; Debug rbtMinimum(t) ; Will return '9' as there are no smaller keys from that node.
If rbt_Color(*NodeAddress\Left) = #rbtNull
ProcedureReturn *NodeAddress\Key
Else
Repeat
*NodeAddress = *NodeAddress\Left
Until rbt_Color(*NodeAddress\Left) = #rbtNull
EndIf
ProcedureReturn *NodeAddress\Key
EndProcedure
Procedure.l rbtMaximum(*NodeAddress.s_RBT) ; Returns the node of the highest key at the starting node.
;
; Usage:
;
; q.l = rbtCreate()
; rbtAdd(q, 9, "")
; rbtAdd(q, 5, "")
; rbtAdd(q, 4, "")
; rbtAdd(q, 10, "")
; ; 5
; ; 4 9
; ; 10
; Debug rbtMaximum(q) ; Will return '10'
; t.l = rbtIndex(q, 4) ; Returns the 'index' (address) for the node with a key of '4'.
; Debug rbtMaximum(t) ; Will return '4' as there are no larger keys from that node.
If rbt_Color(*NodeAddress\Right) = #rbtNull
ProcedureReturn *NodeAddress\Key
Else
Repeat
*NodeAddress = *NodeAddress\Right
Until rbt_Color(*NodeAddress\Right) = #rbtNull
EndIf
ProcedureReturn *NodeAddress\Key
EndProcedure
Procedure.l rbtNodeAddress(*Node.s_RBT, inKey.l) ; Return the 'index' (address) of a node based on it's key.
; The address can then be used for a variety of functions, including the Minimum and Maximum function.
ProcedureReturn rbt_Locate(*Node, inKey)
EndProcedure
Procedure.s rbtLookup(*Root.s_RBT, inKey.l) ; A function to return a value based on it's key.
ProcedureReturn rbt_Find(*Root, inKey)
EndProcedure
Procedure.s rbtSeek(*Node.s_RBT, inAddress.l) ; Returns a value based on a node address.
*Node = inAddress
ProcedureReturn *Node\Value
EndProcedure
Procedure rbtRemove(*Root.s_RBT, inKey.l) ; Called to delete a node from our tree.
;
Protected *rbtInfo.s_rbtInfo
;
Protected *z.s_RBT
Protected *x.s_RBT
Protected *y.s_RBT
;
*rbtInfo = *Root\Parent
; Our information structure for the tree.
*z = rbt_Locate(*Root, inKey)
; Get the address for the node to delete. Start with the real root.
If *z = -1 : ProcedureReturn : EndIf
; If *z is -1, we didn't find the node to delete. Exit.
If *z = *Root And *rbtInfo\NodeCount = 1
; The root is the only item on the tree and that's what we're deleting.
*z\Key = -1
*z\Value = ""
*z\Color = #rbtEmpty
*rbtInfo\NodeCount = 0
ProcedureReturn
EndIf
;
If rbt_Color(*z\Left) = #rbtNull Or rbt_Color(*z\Right) = #rbtNull
*y = *z
Else
*y = rbt_Successor(*z)
If *y\Color = #rbtBlack And rbt_Color(*y\Left) = #rbtNull And rbt_Color(*y\Right) = #rbtNull : *y = rbt_Predeccessor(*z) : EndIf
EndIf
;
If rbt_Color(*y\Left) <> #rbtNull : *x = *y\Left : Else : *x = *y\Right : EndIf
;
If *y = *Root And *rbtInfo\NodeCount = 2
; There are two nodes on the tree and we're burning the root. Copy it's non-leaf child into the root and destroy the child.
*y\Key = *x\Key
*y\Value = *x\Value
If *y\Left = *x
*y\Left = *x\Left
FreeMemory(*x\Right)
Else
*y\Right = *x\Right
FreeMemory(*x\Left)
EndIf
FreeMemory(*x)
ProcedureReturn
EndIf
;
*x\Parent = *y\Parent
; Set the right child of the node to delete's parent to the node's parent.
If *y\Parent <> *rbtInfo
If *y = rbt_Left(*y\Parent) : rbt_SetLChild(*y\Parent, *x) : Else : rbt_SetRChild(*y\Parent, *x) : EndIf
EndIf
; If *y\Parent = *rbtInfo
; ; This will be triggered if Y is the root. It's parent is the information structure.
; ; root[T] = *x
; *Root\Key = *x\Key
; *Root\Value = *x\Value
; ;*Root\Color = *x\Color
; ; I think it's saying that if Y's Parent is NIL (which makes Y the root) then we copy X into the root node, making it the new root instead of Y.
; Else
; If *y = rbt_Left(*y\Parent) : rbt_SetLChild(*y\Parent, *x) : Else : rbt_SetRChild(*y\Parent, *x) : EndIf
; EndIf
;
If *y <> *z
; This happens only if the node to delete had two non-leaf children. If that happened, we searched for a successor to swap with our node-to-delete.
*z\Key = *y\Key
*z\Value = *y\Value
EndIf
;
If *y\Color = #rbtBlack Or *y\Color = #rbtNull
FreeMemory(*y)
; Remove our node from memory. Call this after checking it's color.
rbt_BalanceDelete(*x, *Root)
; Balance our tree after deleting the node.
Else
; Red node, no need to call our balancing function. Just remove the node.
FreeMemory(*y)
EndIf
;
*rbtInfo\NodeCount - 1
; Decrement our node count.
EndProcedure
;- Code
q.l = rbtCreate()
rbtAdd(q, 10, "Sample text 01")
rbtAdd(q, 5, "Sample text 02")
h.l = rbtAdd(q, 3, "Sample text 03")
Debug "Value is: "+rbtLookup(q, 5)
Debug "Value is: "+rbtSeek(q, h)
Debug "Minimum is: "+Str(rbtMinimum(q))
Debug "Maximum is: "+Str(rbtMaximum(q))
rbtRemove(q, 5)
rbt_DestroyDebug(q)
; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
q = rbtCreate()
t1.l
t2.l
t1 = GetTickCount_()
i.l
j.l
k.l
*rbtHold.s_RBT
For i = 1 To 2000000
If i = 298123
j = rbtAdd(q, i, "Hi")
*rbtHold = j
Debug "P: "+Str(rbt_Key(*rbtHold\Parent))
Debug "L: "+Str(rbt_Key(*rbtHold\Left))
Debug "R: "+Str(rbt_Key(*rbtHold\Right))
Debug "Adding special case: "+Str(j)
Else
rbtAdd(q, i, Chr(Random(255)))
EndIf
Next
t2 = GetTickCount_()
MessageRequester("",Str(t2-t1))
;
a.s
t1 = GetTickCount_()
a = rbtLookup(q, 298123)
t2 = GetTickCount_()
MessageRequester(a, Str(t2-t1))
rbtDestroy(q)
; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
EndWhat else? Hmmm.... documentation of the code is spotty at best and probably includes comments based on early code. The code could be updated but not the comments.
And, oh yes, it is very un-optimized and such. I'm always slightly embarassed posting my own code because of how childish it looks compared to a lot of the people here
But perhaps other people will find it useful for their own projects.Enjoy and let me know if y'all find anything I should change or update. And if you update something to add functionality or increase efficiency how about letting us all know so we can update the code?
