Hmmm... I must be doing something wrong, sverson. I tweaked my old code a little bit and added in your examples to do some testing. With 2,000,000 items, it takes x-tree between 30,000ms to 30,469ms to add the items. My rbtree takes between 4870ms to 5781ms. Lookup on both show 0ms.
I'm attaching the code below to see if I've made some mistake somewhere in the testing. I know I use this computer a lot but I didn't know engineering had progressed so far to make a computer feel emotionally biased toward one programmer's code and not another
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
#ListSize = 1999999
;- 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.
EndStructure
;-
XIncludeFile "X-Tree.pbi"
;-
Global Dim SourceList.s(#ListSize)
Global *XTree.XTree_RN
;-
Procedure FillSourceList()
Protected ListPos.l, KeyStr.s, KeyPos.l, EMS.l
For ListPos = 0 To #ListSize
KeyStr=""
For KeyPos = 1 To 10
KeyStr + RSet(Hex(Random($FF)),2,"0")
Next
SourceList(ListPos) = KeyStr
If ListPos = 298123 : SetClipboardText(KeyStr) : EndIf
Next
EndProcedure
Procedure.s FillXTree()
Protected ListPos.l, EMS.l
EMS = ElapsedMilliseconds()
*XTree.XTree_RN = XTree_NewTree(10)
For ListPos = 1 To #ListSize
XTree_NewKey(*XTree,SourceList(ListPos))
Next
MessageRequester("", "XTree: "+Str(#ListSize)+" Elements stored in " +Str(ElapsedMilliseconds()-EMS)+"ms.")
EndProcedure
;-
EnableExplicit
;-
; Macro __rbt_AddNode(HoldNode, key, Value, AsLeft = #True)
; ;
; Define.s_RBT *aNode
; ;
; *aNode = HoldNode
; ;
; *NewNode = AllocateMemory(SizeOf(s_RBT))
; ;
; *NewNode\Parent = *aNode
; ;
; If key = -1
; ;
; *NewNode\left = #rbtNull
; *NewNode\right = #rbtNull
; *NewNode\Color = #rbtNull
; ;
; Else
; ;
; *NewNode\Color = #rbtRed
; ;
; If AsLeft : *NewNode\left = *aNode\left : Else : *NewNode\right = *aNode\right : EndIf
; ;
; *rbtLeaf = AllocateMemory(SizeOf(s_RBT))
; *rbtLeaf\Color = #rbtNull
; *rbtLeaf\Parent = *NewNode
; *rbtLeaf\right = #rbtNull
; *rbtLeaf\left = #rbtNull
; *rbtLeaf\key = -1
; *rbtLeaf\Value = ""
; ;
; If AsLeft : *NewNode\right = *rbtLeaf : Else : *NewNode\left = *rbtLeaf : EndIf
; ;
; EndIf
; ;
; *NewNode\key = key
; *NewNode\Value = Value
; ;
; If AsLeft : *aNode\left = *NewNode : Else : *aNode\right = *NewNode : EndIf
; ;
; EndMacro
Procedure.l __rbt_AddNode(*Node.s_RBT, key.l, Value.s, AsLeft.b = #True)
;
Define.s_RBT *NewNode
;
Define.s_RBT *rbtLeaf
;
*NewNode = AllocateMemory(SizeOf(s_RBT))
;
*NewNode\Parent = *Node
;
If key = -1
;
*NewNode\left = #rbtNull
*NewNode\right = #rbtNull
*NewNode\Color = #rbtNull
;
Else
;
*NewNode\Color = #rbtRed
;
If AsLeft : *NewNode\left = *Node\left : Else : *NewNode\right = *Node\right : EndIf
;
*rbtLeaf = AllocateMemory(SizeOf(s_RBT))
*rbtLeaf\Color = #rbtNull
*rbtLeaf\Parent = *NewNode
*rbtLeaf\right = #rbtNull
*rbtLeaf\left = #rbtNull
*rbtLeaf\key = -1
*rbtLeaf\Value = ""
;
If AsLeft : *NewNode\right = *rbtLeaf : Else : *NewNode\left = *rbtLeaf : EndIf
;
EndIf
;
*NewNode\key = key
*NewNode\Value = Value
;
If AsLeft : *Node\left = *NewNode : Else : *Node\right = *NewNode : EndIf
;
ProcedureReturn *NewNode
;
EndProcedure
Procedure __rbt_RotateLeft(*Node.s_RBT, *Root.s_RBT)
;
Define.l lHold
Define.s_RBT *Child
;
*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
PokeL(*Child\left + OffsetOf(s_RBT\Parent), *Node)
*Child\left = lHold
PokeL(lHold + OffsetOf(s_RBT\Parent), *Child)
;
*Node\right = *Child\right
PokeL(*Child\right + OffsetOf(s_RBT\Parent), *Node)
*Child\right = *Node
*Child\Parent = *Node\Parent
*Node\Parent = *Child
;
Swap *Node\key, *Child\key
Swap *Node\Value, *Child\Value
Swap *Node\Color, *Child\Color
;
*Node = *Node\Parent
;
*Child = *Node\right
;
EndIf
;
lHold = *Child\left
*Child\left = *Node
*Node\right = lHold
;
*Child\Parent = *Node\Parent
If *Child <> *Root
If PeekL(*Node\Parent + OffsetOf(s_RBT\right)) = *Node
PokeL(*Node\Parent + OffsetOf(s_RBT\right), *Child)
Else
PokeL(*Node\Parent + OffsetOf(s_RBT\left), *Child)
EndIf
EndIf
*Node\Parent = *Child
PokeL(lHold + OffsetOf(s_RBT\Parent), *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
PokeL(*Child\right + OffsetOf(s_RBT\Parent), *Node)
*Child\right = lHold
PokeL(lHold + OffsetOf(s_RBT\Parent), *Child)
;
*Node\left = *Child\left
PokeL(*Child\left + OffsetOf(s_RBT\Parent), *Node)
*Child\left = *Node
*Child\Parent = *Node\Parent
*Node\Parent = *Child
;
Swap *Node\key, *Child\key
Swap *Node\Value, *Child\Value
Swap *Node\Color, *Child\Color
;
*Node = *Node\Parent
*Child = *Node\left
;
EndIf
;
lHold = *Child\right
*Child\right = *Node
*Node\left = lHold
;
*Child\Parent = *Node\Parent
If *Child <> *Root
If PeekL(*Node\Parent + OffsetOf(s_RBT\left)) = *Node
PokeL(*Node\Parent + OffsetOf(s_RBT\left), *Child)
Else
PokeL(*Node\Parent + OffsetOf(s_RBT\right), *Child)
EndIf
EndIf
*Node\Parent = *Child
PokeL(lHold + OffsetOf(s_RBT\Parent), *Node)
;
EndProcedure
Procedure __rbt_BalanceInsert(*z.s_RBT, *Root.s_RBT)
;
Define.s_RBT *pz
Define.s_RBT *Y
;
*pz = *z\Parent
;
While *pz\Color = #rbtRed
;
If *pz = PeekL(*pz\Parent + OffsetOf(s_RBT\left))
; Our parent is the left child of it's parent.
*y = PeekL(*pz\Parent + OffsetOf(s_RBT\right))
If *y\Color = #rbtRed
*pz\Color = #rbtBlack
*y\Color = #rbtBlack
PokeB(*pz\Parent, #rbtRed)
*z = *pz\Parent
Else
If *z = *pz\right
*z = *pz
__rbt_RotateLeft(*z, *Root)
*pz = *z\Parent
EndIf
*pz\Color = #rbtBlack
PokeB(*pz\Parent, #rbtRed)
__rbt_RotateRight(*pz\Parent, *Root)
EndIf
Else
; Our parent is the right child of it's parent.
*y = PeekL(*pz\Parent + OffsetOf(s_RBT\left))
If *y\Color = #rbtRed
*pz\Color = #rbtBlack
*y\Color = #rbtBlack
PokeB(*pz\Parent, #rbtRed)
*z = *pz\Parent
Else
If *z = *pz\left
*z = *pz
__rbt_RotateRight(*z, *Root)
*pz = *z\Parent
EndIf
*pz\Color = #rbtBlack
PokeB(*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, key.l, Value.s) ; A private function to insert a key into the tree.
;
Define.s_rbtInfo *rbtInfo
;
*rbtInfo = *Node\Parent
;
While #True = #True
;
If key <= *Node\key
;
If *Node\key = key
; 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 PeekB(*Node\left) = #rbtNull
; Left child is a leaf - Null value so add it here.
ProcedureReturn __rbt_AddNode(*Node, key, Value, #True)
; Return the address of the new node.
Else
;
*Node = *Node\left
; Not a leaf, keep checking by descending the left child.
EndIf
;
Else
;
If PeekB(*Node\right) = #rbtNull
; Right child is a leaf - Null value so add it here.
ProcedureReturn __rbt_AddNode(*Node, key, Value, #False)
; Return the address of the new node.
Else
*Node = *Node\right
; Not a leaf, keep checking by descending the right child.
EndIf
;
EndIf
;
Wend
;
ProcedureReturn -1
; If we got to this point then we couldn't add it. Should be because of a Duplicate/Denied addition.
EndProcedure
Procedure.l __rbt_Successor(*Node.s_RBT)
Protected *rbtHold.s_RBT
If PeekB(*Node\right) <> #rbtNull
;
*rbtHold = *Node\right
;
While PeekB(*rbtHold\left) <> #rbtNull : *rbtHold = *rbtHold\left : Wend
;
ProcedureReturn *rbtHold
;
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 PeekB(*Node\left) <> #rbtNull
*rbtHold = *Node\left
While PeekB(*rbtHold\right) <> #rbtNull : *rbtHold = *rbtHold\right : Wend
ProcedureReturn *rbtHold
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 (PeekB(*w\left) = #rbtBlack Or PeekB(*w\left) = #rbtNull) And (PeekB(*w\right) = #rbtBlack Or PeekB(*w\right) = #rbtNull)
*w\Color = #rbtRed
*x = *px
Else
If PeekB(*w\right) = #rbtBlack Or PeekB(*w\right) = #rbtNull
PokeB(*w\left, #rbtBlack) ; Check to see if a Null check is required.
*w\Color = #rbtRed
__rbt_RotateRight(*w, *Root)
*w = *px\right
EndIf
*w\Color = *px\Color
*px\Color = #rbtBlack
PokeB(*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 (PeekB(*w\left) = #rbtBlack Or PeekB(*w\left) = #rbtNull) And (PeekB(*w\right) = #rbtBlack Or PeekB(*w\right) = #rbtNull)
*w\Color = #rbtRed
*x = *px
Else
If PeekB(*w\left) = #rbtBlack Or PeekB(*w\left) = #rbtNull
PokeB(*w\right, #rbtBlack) ; Check to see if a Null check is required.
*w\Color = #rbtRed
__rbt_RotateLeft(*w, *Root)
*w = *px\left
EndIf
*w\Color = *px\Color
*px\Color = #rbtBlack
PokeB(*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
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 PeekB(*Node\left) = #rbtNull
; No left children for the root.
If PeekB(*Node\right) = #rbtNull
; Debug "Destroying the root."
; And no right children either. We're done.
Debug "Burning the root's right child ("+Str(PeekL(*Node\right + OffsetOf(s_RBT\key)))+", "+Str(*Node\right)+")."
FreeMemory(*Node\right)
Debug "Burning the root's left child ("+Str(PeekL(*Node\left + OffsetOf(s_RBT\key)))+", "+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 PeekB(*Node\left) = #rbtNull
; No more left children
If PeekB(*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.
PokeL(*Node\left + OffsetOf(s_RBT\Parent), *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.
PokeL(*Node\right + OffsetOf(s_RBT\Parent), *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 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.
While *Node <> #rbtNull
;
If *Node = *Root
; We're at the root.
If PeekB(*Node\left) = #rbtNull
; No left children for the root.
If PeekB(*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 PeekB(*Node\left) = #rbtNull
; No more left children
If PeekB(*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.
PokeL(*Node\left + OffsetOf(s_RBT\Parent), *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.
PokeL(*Node\right + OffsetOf(s_RBT\Parent), *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
;
Wend
;
EndProcedure
Procedure rbtRemove(*Root.s_RBT, inKey.l) ; Called to delete a node from our tree.
;
Protected *rbtInfo.s_rbtInfo
;
Define.s_RBT *Node
;
Protected *z.s_RBT
Protected *x.s_RBT
Protected *y.s_RBT
;
*rbtInfo = *Root\Parent
; Our information structure for the tree.
*Node = *Root
;
While *Node\Color <> #rbtNull
If *Node\key = inKey
*z = *Node : Break
Else
If inKey <= *Node\key
*Node = *Node\left
Else
*Node = *Node\right
EndIf
EndIf
Wend
; Will never return a Nil leaf since we change nodes right before checking this.
If *z = 0 : 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 PeekB(*z\left) = #rbtNull Or PeekB(*z\right) = #rbtNull
*y = *z
Else
*y = __rbt_Successor(*z)
If *y\Color = #rbtBlack And PeekB(*y\left) = #rbtNull And PeekB(*y\right) = #rbtNull : *y = __rbt_Predeccessor(*z) : EndIf
EndIf
;
If PeekB(*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 = PeekL(*y\Parent + OffsetOf(s_RBT\left)) : PokeL(*y\Parent + OffsetOf(s_RBT\left), *x) : Else : PokeL(*y\Parent + OffsetOf(s_RBT\right), *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
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.
While PeekB(*NodeAddress\left) <> #rbtNull : *NodeAddress = *NodeAddress\left : Wend
;
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.
While PeekB(*NodeAddress\right) <> #rbtNull : *NodeAddress = *NodeAddress\right : Wend
;
ProcedureReturn *NodeAddress\key
;
EndProcedure
Procedure.s rbtSeek(*Node.s_RBT, inAddress.l) ; Returns a value based on a node address.
*Node = inAddress
ProcedureReturn *Node\Value
EndProcedure
Procedure.s rbtFind(*Node.s_RBT, inKey.l) ; A private function to return a value based on it's key.
While *Node\Color <> #rbtNull
If *Node\key = inKey
ProcedureReturn *Node\Value
Else
If inKey <= *Node\key
*Node = *Node\left
Else
*Node = *Node\right
EndIf
EndIf
Wend
; Will never match against a Nil leaf since we move nodes and then check this condition.
ProcedureReturn ""
EndProcedure
Procedure.l rbtAdd(*Root.s_RBT, inKey.l, inValue.s) ; Called to add a new key/value pair to our tree.
;
Define.s_RBT *Node
Define.s_rbtInfo *rbtInfo
;
Define.l lHold
;
*rbtInfo = *Root\Parent
;
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.
lHold = __rbt_Insert(*Root, inKey, inValue)
; Start our insertion routine with the address of the root element.
If lHold <> -1
; Return -1 if we did not insert our node.
*rbtInfo\NodeCount + 1
; Increase our node count.
__rbt_BalanceInsert(lHold, *Root)
; Now balance our newly inserted item if it needs to be balanced.
ProcedureReturn lHold
;
EndIf
EndIf
;
EndProcedure
Procedure.l rbtCreate() ; Create the initial tree. Always call this first and pass it's result to the other functions.
;
Define.s_RBT *Tree
Define.s_rbtInfo *rbtInfo
;
Define.s_RBT *NewNode
Define.s_RBT *rbtLeaf
;
*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.
__rbt_AddNode(*Tree, -1, "", #True)
; Add our Nil left leaf.
__rbt_AddNode(*Tree, -1, "", #False)
; Add our Nil right leaf.
ProcedureReturn *Tree
; Return the address of the root node.
EndProcedure
;- Code
; Define.l q, t
; q = rbtCreate()
; rbtAdd(q, 9, "")
; rbtAdd(q, 5, "")
; rbtAdd(q, 4, "")
; rbtAdd(q, 10, "")
; ; 5
; ; 4 9
; ; 10
; Debug rbtMaximum(q) ; Will return '4'
; ; Debug rbtMinimum(t) ; Will return '9' as there are no smaller keys from that node.
; rbtDestroy(q)
;-
; Define.l q, h
; 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: "+rbtFind(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)
;-
FillSourceList()
; Fill the source list for testing.
Define.l i, t1, t2
;
Delay(500)
; t1 = GetTickCount_()
FillXTree()
; Test filling sverson's x-tree.
t1 = ElapsedMilliseconds()
i = XTree_FindKey(*XTree, SourceList(298123))
t2 = ElapsedMilliseconds()
MessageRequester("X-Tree Located "+Str(i), StrQ(t2-t1))
;
Define.s a
Define.s_RBT *rbtHold
Define.l q, t1, t2, i, j, k
t1 = ElapsedMilliseconds()
q = rbtCreate()
For i = 0 To #ListSize : rbtAdd(q, i, SourceList(i)) : Next
t2 = ElapsedMilliseconds()
MessageRequester("", StrQ(t2-t1))
;
t1 = ElapsedMilliseconds()
a = rbtFind(q, 298123)
t2 = ElapsedMilliseconds()
MessageRequester(a, StrQ(t2-t1))
rbtDestroy(q)
;-
End
Also, my code could be modified to use any kind of key and/or value but I'm used to indexes & string values for database kinds of things. I guess it's my fault that I didn't look too closely at the original post?
I will have to see if I can remedy that 
sverson
