; English forum: http://www.purebasic.fr/english/viewtopic.php?t=13432&highlight=
; Author: Xombie (updated for PB 4.00 by Andre)
; Date: 20. December 2004
; OS: Windows
; Demo: Yes

; 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. 


; More author comments:
; 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. 
; 
; 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? 


;- 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 = ElapsedMilliseconds() 
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 = ElapsedMilliseconds() 
MessageRequester("",Str(t2-t1)) 
; 
a.s 
t1 = ElapsedMilliseconds() 
a = rbtLookup(q, 298123) 
t2 = ElapsedMilliseconds() 
MessageRequester(a, Str(t2-t1)) 
rbtDestroy(q) 
; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
End 



; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -------