Menu
I am using the Red-Black tree implementation written by Julian Bucknall in his well-known book, The Tomes Of Delphi. Source code can be downloaded here, and I am using the code as-is in Delphi 2010, with modifications to TdBasics.pas to let it compile in a modern version of Delphi (mostly commenting most of it out - only a few definitions are required by the tree code.)
This is a well-known implementation by a famous author, in an often-recommended book. I feel I should be on solid ground using it. But I am encountering crashes using Delete() and Promote(). Stepping back to write unit tests with DUnit, these problems are easily reproducible. Some example code is (snippets from my DUnit tests):
// Tests that require an initialised tree start with one with seven items
const
NumInitialItems : Integer = 7;
...
// Data is an int, not a pointer
function Compare(aData1, aData2: Pointer): Integer;
begin
if NativeInt(aData1) < NativeInt(aData2) then Exit(-1);
if NativeInt(aData1) > NativeInt(aData2) then Exit(1);
Exit(0);
end;
// Add seven items (0..6) to the tree. Node.Data is a pointer field, just cast.
procedure TestTRedBlackTree.SetUp;
var
Loop : Integer;
begin
FRedBlackTree := TtdRedBlackTree.Create(Compare, nil);
for Loop := 0 to NumInitialItems - 1 do begin
FRedBlackTree.Insert(Pointer(Loop));
end;
end;
...
// Delete() crashes for the first item, no matter if it is 0 or 1 or...
procedure TestTRedBlackTree.TestDelete;
var
aItem: Pointer;
Loop : Integer;
begin
for Loop := 1 to NumInitialItems - 1 do begin // In case 0 (nil) causes problems, but 1 fails too
aItem := Pointer(Loop);
Check(FRedBlackTree.Find(aItem) = aItem, 'Item not found before deleting');
FRedBlackTree.Delete(aItem);
Check(FRedBlackTree.Find(aItem) = nil, 'Item found after deleting');
Check(FRedBlackTree.Count = NumInitialItems - Loop, 'Item still in the tree');
end;
end;
I'm not solid enough in the algorithms to know how to fix it without introducing further problems (unbalanced or incorrect tree.) I know, because I've tried :)
The above test fails in Promote() when deleting an item, on the line marked !!!:
function TtdRedBlackTree.rbtPromote(aNode : PtdBinTreeNode)
: PtdBinTreeNode;
var
Parent : PtdBinTreeNode;
begin
{make a note of the parent of the node we're promoting}
Parent := aNode^.btParent;
{in both cases there are 6 links to be broken and remade: the node's
link to its child and vice versa, the node's link with its parent
and vice versa and the parent's link with its parent and vice
versa; note that the node's child could be nil}
{promote a left child = right rotation of parent}
if (Parent^.btChild[ctLeft] = aNode) then begin
Parent^.btChild[ctLeft] := aNode^.btChild[ctRight];
if (Parent^.btChild[ctLeft] <> nil) then
Parent^.btChild[ctLeft]^.btParent := Parent;
aNode^.btParent := Parent^.btParent;
if (aNode^.btParent^.btChild[ctLeft] = Parent) then //!!!
aNode^.btParent^.btChild[ctLeft] := aNode
else
aNode^.btParent^.btChild[ctRight] := aNode;
aNode^.btChild[ctRight] := Parent;
Parent^.btParent := aNode;
end
...
Parent.btParent (becoming aNode.btParent) is nil, thus the crash. Examining the tree structure, the node's parent is the root node, which obviously has a nil parent itself.
I tried simply testing for this and only running that if/then/else statement when a grandparent existed. While this seems logical, it's kind of a naive fix; I don't understand the rotations well enough to know if this is valid or if something else should happen instead - and doing so causes another problem, mentioned after the snippet. (Note there is a duplicate of this code below the snippet copied above for a left rotation, and the same bug occurs there too.)
if aNode.btParent <> nil then begin //!!! Grandparent doesn't exist, because parent is root node
if (aNode^.btParent^.btChild[ctLeft] = Parent) then
aNode^.btParent^.btChild[ctLeft] := aNode
else
aNode^.btParent^.btChild[ctRight] := aNode;
aNode^.btChild[ctRight] := Parent;
end;
Parent^.btParent := aNode;
...
Using this code, the test for Delete still fails, but with something more odd: after the call to Delete(), the call to Find() correctly returns nil, indicating the item was removed. However, the last iteration of the loop, removing item 6, causes a crash in TtdBinarySearchTree.bstFindItem:
Walker := FBinTree.Root;
CmpResult := FCompare(aItem, Walker^.btData);
FBinTree.Root is nil, crashing when calling FCompare.
So - at this point I can tell my modifications are clearly just causing more problems, and something else more fundamental is wrong with the code implementing the algorithm. Unfortunately, even with the book as reference, I can't figure out what is wrong, or rather, what a correct implementation would look like and what's different here.
I originally thought it must have been my code incorrectly using the tree, causing the problems. This is still very possible! The author, the book and thus implicitly the code are well-known in the Delphi world. But the crashes are easily reproducible, writing some very basic unit tests for the class, using the book's source code downloaded from the author's site. Someone else must have also used this code sometime in the past decade, and encountered the same problem (unless the bug is mine and both my code and unit tests are using the tree incorrectly.) I am seeking answers helping with:
Promote and elsewhere in the class. Note that I have also written unit tests for the base class, TtdBinarySearchTree, and those all pass. (That doesn't mean it's perfect - I might not have identified failing cases. But it's some help.)Commenter MBo points out Julian's EZDSL library, which contains another implementation of a red-black tree. Unit tests on this version pass. I am currently comparing the two sources to try to see where the algorithms deviate, to find the bug.
One possibility is to simply use the EZDSL red-black tree, not the Tomes of Delphi red-black tree, but there are a few problems with the library that make me not keen to use it: It's written for 32-bit x86 only; some methods are provided in assembly only, not Pascal (though most have two versions); the trees are structured quite differently, such as using cursors to nodes instead of pointers - a perfectly valid approach, but an example of how different the code is to the 'example' code in the ToD book, where navigation is semantically different; the code is, in my opinion, much harder to understand and use: it's quite heavily optimised, variables and methods are as not as clearly named, there are a variety of magic functions, the node structure is actually a union / case record, squishing in details for stacks, queues, dequeues and lists, double-linked-lists, skips lists, trees, binary trees and heaps all in one structure that is almost incomprehensible in the debugger, etc. It's not code I am keen to use in production where I will need to support it, nor is it easy to learn from. The Tomes of Delphi source code is much more readable and much more maintainable... but also incorrect. You see the dilemma :)
I am attempting to compare the code to try to find differences between Julian's in-practice code (EZDSL) and his teaching code (Tomes of Delphi.) But this question is still open and I will still be grateful for answers. I can't be the only person to use the red-black trees from the Tomes of Delphi in the twelve years since it was published :)
I've answered this myself (in spite of offering a bounty. Oops.) I had trouble finding the bugs purely by examining the code and comparing to the ToD description of the algorithm, so instead I reimplemented the flawed methods based on a good page describing the structure that came with a MIT-licensed C implementation; details below. One bonus is that I think the new implementation is actually much clearer to understand.
261
A red-black tree is a kind of self-balancing binary search tree where each node has an extra bit, and that bit is often interpreted as the color (red or black). These colors are used to ensure that the tree remains balanced during insertions and deletions.
Complexity Red-black trees offer logarithmic average and worst-case time complexity for insertion, search, and deletion. Rebalancing has an average time complexity of O(1) and worst-case complexity of O(log n).
R-B trees aren't really designed for data structures which support duplicates, but rather sets.
Red Black Trees provide faster insertion and removal operations than AVL trees as fewer rotations are done due to relatively relaxed balancing. AVL trees provide complex insertion and removal operations as more rotations are done due to relatively relaxed balancing.
I haven't managed to figure out what's wrong by examining the Tomes of Delphi source code and comparing to either the algorithm or Julian's other implementation, the heavily-optimised EZDSL library implementation (thus this question!), but I have instead re-implemented Delete, and for good measure also Insert, based on the example C code for a red-black tree on the Literate Programming site, one of the clearest examples of a red-black tree I found. (It's actually quite a hard task to find a bug purely by grinding through the code and verifying it implements something correctly, especially when you don't fully understand the algorithm. I can tell you, I have a much better understanding now!) The tree is quite well documented - I think the Tomes of Delphi gives a better overview of the reasons for why the tree works as it does, but this code is a better example of a readable implementation.
Notes about this:
FHead node, the child of which is the tree's root, which you have to be aware of when converting. (Tests often tested if a node's parent was NULL as a way of testing if the node was the root node. I have extracted this and other similar logic to helper methods, or node or tree methods.)TtdBinaryTree, TtdBinarySearchTree and TtdRedBlackTree found in TDBinTre.pas (source code download on the ToD page.) To use it, edit that file. It's not a new implementation, and isn't complete on its own. Specifically, it keeps the ToD code's structure, such as TtdBinarySearchTree not being a descendant of TtdBinaryTree but owning one as a member (ie wrapping it), using a FHead node instead of a nil parent to the Root, etc.RotateLeft and RotateRight), which I find useful - the ToD code talks about rotations but doesn't explicitly pull them into separate named methods. Delete is similar: it goes into a number of cases. Each case is explained on the page, and as comments in my code. Some of these I named, but some are too complex to put in a method name, so are just "case 4", "case 5" etc, with comments explaining.On to the code!
I added the following helper methods to the node, to make the code more literate when reading. For example, the original code often tested if a node was the left child of its parent by testing (blind conversion to Delphi and unmodified ToD structures) if Node = Node.Parent.btChild[ctLeft] then... whereas now you can test if Node.IsLeft then... etc. The method prototypes in the record definition aren't included to save space, but should be obvious :)
function TtdBinTreeNode.Parent: PtdBinTreeNode;
begin
assert(btParent <> nil, 'Parent is nil');
Result := btParent;
end;
function TtdBinTreeNode.Grandparent: PtdBinTreeNode;
begin
assert(btParent <> nil, 'Parent is nil');
Result := btParent.btParent;
assert(Result <> nil, 'Grandparent is nil - child of root node?');
end;
function TtdBinTreeNode.Sibling: PtdBinTreeNode;
begin
assert(btParent <> nil, 'Parent is nil');
if @Self = btParent.btChild[ctLeft] then
Exit(btParent.btChild[ctRight])
else
Exit(btParent.btChild[ctLeft]);
end;
function TtdBinTreeNode.Uncle: PtdBinTreeNode;
begin
assert(btParent <> nil, 'Parent is nil');
// Can be nil if grandparent has only one child (children of root have no uncle)
Result := btParent.Sibling;
end;
function TtdBinTreeNode.LeftChild: PtdBinTreeNode;
begin
Result := btChild[ctLeft];
end;
function TtdBinTreeNode.RightChild: PtdBinTreeNode;
begin
Result := btChild[ctRight];
end;
function TtdBinTreeNode.IsLeft: Boolean;
begin
Result := @Self = Parent.LeftChild;
end;
function TtdBinTreeNode.IsRight: Boolean;
begin
Result := @Self = Parent.RightChild;
end;
I also added extra methods like the existing IsRed(), to test if it is black (IMO code scans nicer if it says if IsBlack(Node) not if not IsRed(Node), and to get the colour, including handling a nil node. Note that these need to be consistent - IsRed, for example, returns false for a nil node, so a nil node is black. (This also ties in to the properties of a red-black tree, and the consistent number of black nodes on a path to a leaf.)
function IsBlack(aNode : PtdBinTreeNode) : boolean;
begin
Result := not IsRed(aNode);
end;
function NodeColor(aNode :PtdBinTreeNode) : TtdRBColor;
begin
if aNode = nil then Exit(rbBlack);
Result := aNode.btColor;
end;
As mentioned above, these methods verify the structure of the tree and the red-black constraints, and are a direct translation of the same methods in the original C code. Verify is declared as inline if not debug in the class definition. If not debug, the method should be empty and will hopefully be completely removed by the compiler. Verify is called at the beginning and end of the Insert and Delete methods, to ensure the tree was correct before and after modification.
procedure TtdRedBlackTree.Verify;
begin
{$ifdef DEBUG}
VerifyNodesRedOrBlack(FBinTree.Root);
VerifyRootIsBlack;
// 3 is implicit
VerifyRedBlackRelationship(FBinTree.Root);
VerifyBlackNodeCount(FBinTree.Root);
{$endif}
end;
procedure TtdRedBlackTree.VerifyNodesRedOrBlack(const Node : PtdBinTreeNode);
begin
// Normally implicitly ok in Delphi, due to type system - can't assign something else
// However, node uses a union / case to write to the same value, theoretically
// only for other tree types, so worth checking
assert((Node.btColor = rbRed) or (Node.btColor = rbBlack));
if Node = nil then Exit;
VerifyNodesRedOrBlack(Node.LeftChild);
VerifyNodesRedOrBlack(Node.RightChild);
end;
procedure TtdRedBlackTree.VerifyRootIsBlack;
begin
assert(IsBlack(FBinTree.Root));
end;
procedure TtdRedBlackTree.VerifyRedBlackRelationship(const Node : PtdBinTreeNode);
begin
// Every red node has two black children; or, the parent of every red node is black.
if IsRed(Node) then begin
assert(IsBlack(Node.LeftChild));
assert(IsBlack(Node.RightChild));
assert(IsBlack(Node.Parent));
end;
if Node = nil then Exit;
VerifyRedBlackRelationship(Node.LeftChild);
VerifyRedBlackRelationship(Node.RightChild);
end;
procedure VerifyBlackNodeCountHelper(const Node : PtdBinTreeNode; BlackCount : NativeInt; var PathBlackCount : NativeInt);
begin
if IsBlack(Node) then begin
Inc(BlackCount);
end;
if Node = nil then begin
if PathBlackCount = -1 then begin
PathBlackCount := BlackCount;
end else begin
assert(BlackCount = PathBlackCount);
end;
Exit;
end;
VerifyBlackNodeCountHelper(Node.LeftChild, BlackCount, PathBlackCount);
VerifyBlackNodeCountHelper(Node.RightChild, BlackCount, PathBlackCount);
end;
procedure TtdRedBlackTree.VerifyBlackNodeCount(const Node : PtdBinTreeNode);
var
PathBlackCount : NativeInt;
begin
// All paths from a node to its leaves contain the same number of black nodes.
PathBlackCount := -1;
VerifyBlackNodeCountHelper(Node, 0, PathBlackCount);
end;
Helper methods to check if a node is the root node, to set a node as the root, to replace one node with another, to perform left and right rotations, and to follow a tree down the right-hand nodes to the leaf. Make these protected members of the red-black tree class.
procedure TtdRedBlackTree.RotateLeft(Node: PtdBinTreeNode);
var
R : PtdBinTreeNode;
begin
R := Node.RightChild;
ReplaceNode(Node, R);
Node.btChild[ctRight] := R.LeftChild;
if R.LeftChild <> nil then begin
R.LeftChild.btParent := Node;
end;
R.btChild[ctLeft] := Node;
Node.btParent := R;
end;
procedure TtdRedBlackTree.RotateRight(Node: PtdBinTreeNode);
var
L : PtdBinTreeNode;
begin
L := Node.LeftChild;
ReplaceNode(Node, L);
Node.btChild[ctLeft] := L.RightChild;
if L.RightChild <> nil then begin
L.RightChild.btParent := Node;
end;
L.btChild[ctRight] := Node;
Node.btParent := L;
end;
procedure TtdRedBlackTree.ReplaceNode(OldNode, NewNode: PtdBinTreeNode);
begin
if IsRoot(OldNode) then begin
SetRoot(NewNode);
end else begin
if OldNode.IsLeft then begin // // Is the left child of its parent
OldNode.Parent.btChild[ctLeft] := NewNode;
end else begin
OldNode.Parent.btChild[ctRight] := NewNode;
end;
end;
if NewNode <> nil then begin
newNode.btParent := OldNode.Parent;
end;
end;
function TtdRedBlackTree.IsRoot(const Node: PtdBinTreeNode): Boolean;
begin
Result := Node = FBinTree.Root;
end;
procedure TtdRedBlackTree.SetRoot(Node: PtdBinTreeNode);
begin
Node.btColor := rbBlack; // Root is always black
FBinTree.SetRoot(Node);
Node.btParent.btColor := rbBlack; // FHead is black
end;
function TtdRedBlackTree.MaximumNode(Node: PtdBinTreeNode): PtdBinTreeNode;
begin
assert(Node <> nil);
while Node.RightChild <> nil do begin
Node := Node.RightChild;
end;
Result := Node;
end;
The red-black tree is a wrapper around an internal tree, FBinTree. In a too-connected manner this code modifies the tree directly. Both FBinTree and the wrapper red-black tree keep a count FCount of the number of nodes, and to make this cleaner I removed TtdBinarySearchTree (the ancestor of the red-black tree)'s FCount and redirected Count to return FBinTree.Count, i.e. ask the actual internal tree that the binary search tree and red-black tree classes use - which is after all the thing that owns the nodes. I've also added notification methods NodeInserted and NodeRemoved to increment and decrement the counts. Code not included (trivial).
I also extracted some methods for allocating a node and disposing of a node - not to insert or delete from the tree or do anything about a node's connections or presence; these are to look after creation and destruction of a node itself. Note that node creation needs to set the node's color to red - color changes are looked after after this point. This also ensures that when a node is freed, there is an opportunity to free the data associated with it.
function TtdBinaryTree.NewNode(const Item : Pointer): PtdBinTreeNode;
begin
{allocate a new node }
Result := BTNodeManager.AllocNode;
Result^.btParent := nil;
Result^.btChild[ctLeft] := nil;
Result^.btChild[ctRight] := nil;
Result^.btData := Item;
Result.btColor := rbRed; // Red initially
end;
procedure TtdBinaryTree.DisposeNode(Node: PtdBinTreeNode);
begin
// Free whatever Data was pointing to, if necessary
if Assigned(FDispose) then FDispose(Node.btData);
// Free the node
BTNodeManager.FreeNode(Node);
// Decrement the node count
NodeRemoved;
end;
With these extra methods, use the following code for insertion and deletion. Code is commented, but I recommend you read the original page and also the Tomes of Delphi book for an explanation of rotations, and the various cases that the code tests for.
procedure TtdRedBlackTree.Insert(aItem : pointer);
var
NewNode, Node : PtdBinTreeNode;
Comparison : NativeInt;
begin
Verify;
newNode := FBinTree.NewNode(aItem);
assert(IsRed(NewNode)); // new node is red
if IsRoot(nil) then begin
SetRoot(NewNode);
NodeInserted;
end else begin
Node := FBinTree.Root;
while True do begin
Comparison := FCompare(aItem, Node.btData);
case Comparison of
0: begin
// Equal: tree doesn't support duplicate values
assert(false, 'Should not insert a duplicate item');
FBinTree.DisposeNode(NewNode);
Exit;
end;
-1: begin
if Node.LeftChild = nil then begin
Node.btChild[ctLeft] := NewNode;
Break;
end else begin
Node := Node.LeftChild;
end;
end;
else begin
assert(Comparison = 1, 'Only -1, 0 and 1 are valid comparison values');
if Node.RightChild = nil then begin
Node.btChild[ctRight] := NewNode;
Break;
end else begin
Node := Node.RightChild;
end;
end;
end;
end;
NewNode.btParent := Node; // Because assigned to left or right child above
NodeInserted; // Increment count
end;
InsertCase1(NewNode);
Verify;
end;
// Node is now the root of the tree. Node must be black; because it's the only
// node, there is only one path, so the number of black nodes is ok
procedure TtdRedBlackTree.InsertCase1(Node: PtdBinTreeNode);
begin
if not IsRoot(Node) then begin
InsertCase2(Node);
end else begin
// Node is root (the less likely case)
Node.btColor := rbBlack;
end;
end;
// New node has a black parent: all properties ok
procedure TtdRedBlackTree.InsertCase2(Node: PtdBinTreeNode);
begin
// If it is black, then everything ok, do nothing
if not IsBlack(Node.Parent) then InsertCase3(Node);
end;
// More complex: uncle is red. Recolor parent and uncle black and grandparent red
// The grandparent change may break the red-black properties, so start again
// from case 1.
procedure TtdRedBlackTree.InsertCase3(Node: PtdBinTreeNode);
begin
if IsRed(Node.Uncle) then begin
Node.Parent.btColor := rbBlack;
Node.Uncle.btColor := rbBlack;
Node.Grandparent.btColor := rbRed;
InsertCase1(Node.Grandparent);
end else begin
InsertCase4(Node);
end;
end;
// "In this case, we deal with two cases that are mirror images of one another:
// - The new node is the right child of its parent and the parent is the left child
// of the grandparent. In this case we rotate left about the parent.
// - The new node is the left child of its parent and the parent is the right child
// of the grandparent. In this case we rotate right about the parent.
// Neither of these fixes the properties, but they put the tree in the correct form
// to apply case 5."
procedure TtdRedBlackTree.InsertCase4(Node: PtdBinTreeNode);
begin
if (Node.IsRight) and (Node.Parent = Node.Grandparent.LeftChild) then begin
RotateLeft(Node.Parent);
Node := Node.LeftChild;
end else if (Node.IsLeft) and (Node.Parent = Node.Grandparent.RightChild) then begin
RotateRight(Node.Parent);
Node := Node.RightChild;
end;
InsertCase5(Node);
end;
// " In this final case, we deal with two cases that are mirror images of one another:
// - The new node is the left child of its parent and the parent is the left child
// of the grandparent. In this case we rotate right about the grandparent.
// - The new node is the right child of its parent and the parent is the right child
// of the grandparent. In this case we rotate left about the grandparent.
// Now the properties are satisfied and all cases have been covered."
procedure TtdRedBlackTree.InsertCase5(Node: PtdBinTreeNode);
begin
Node.Parent.btColor := rbBlack;
Node.Grandparent.btColor := rbRed;
if (Node.IsLeft) and (Node.Parent = Node.Grandparent.LeftChild) then begin
RotateRight(Node.Grandparent);
end else begin
assert((Node.IsRight) and (Node.Parent = Node.Grandparent.RightChild));
RotateLeft(Node.Grandparent);
end;
end;
procedure TtdRedBlackTree.Delete(aItem : pointer);
var
Node,
Predecessor,
Child : PtdBinTreeNode;
begin
Node := bstFindNodeToDelete(aItem);
if Node = nil then begin
assert(false, 'Node not found');
Exit;
end;
if (Node.LeftChild <> nil) and (Node.RightChild <> nil) then begin
Predecessor := MaximumNode(Node.LeftChild);
Node.btData := aItem;
Node := Predecessor;
end;
assert((Node.LeftChild = nil) or (Node.RightChild = nil));
if Node.LeftChild = nil then
Child := Node.RightChild
else
Child := Node.LeftChild;
if IsBlack(Node) then begin
Node.btColor := NodeColor(Child);
DeleteCase1(Node);
end;
ReplaceNode(Node, Child);
if IsRoot(Node) and (Child <> nil) then begin
Child.btColor := rbBlack;
end;
FBinTree.DisposeNode(Node);
Verify;
end;
// If Node is the root node, the deletion removes one black node from every path
// No properties violated, return
procedure TtdRedBlackTree.DeleteCase1(Node: PtdBinTreeNode);
begin
if IsRoot(Node) then Exit;
DeleteCase2(Node);
end;
// Node has a red sibling; swap colors, and rotate so the sibling is the parent
// of its former parent. Continue to one of the next cases
procedure TtdRedBlackTree.DeleteCase2(Node: PtdBinTreeNode);
begin
if IsRed(Node.Sibling) then begin
Node.Parent.btColor := rbRed;
Node.Sibling.btColor := rbBlack;
if Node.IsLeft then begin
RotateLeft(Node.Parent);
end else begin
RotateRight(Node.Parent);
end;
end;
DeleteCase3(Node);
end;
// Node's parent, sibling and sibling's children are black; paint the sibling red.
// All paths through Node now have one less black node, so recursively run case 1
procedure TtdRedBlackTree.DeleteCase3(Node: PtdBinTreeNode);
begin
if IsBlack(Node.Parent) and
IsBlack(Node.Sibling) and
IsBlack(Node.Sibling.LeftChild) and
IsBlack(Node.Sibling.RightChild) then
begin
Node.Sibling.btColor := rbRed;
DeleteCase1(Node.Parent);
end else begin
DeleteCase4(Node);
end;
end;
// Node's sibling and sibling's children are black, but node's parent is red.
// Swap colors of sibling and parent Node; restores the tree properties
procedure TtdRedBlackTree.DeleteCase4(Node: PtdBinTreeNode);
begin
if IsRed(Node.Parent) and
IsBlack(Node.Sibling) and
IsBlack(Node.Sibling.LeftChild) and
IsBlack(Node.Sibling.RightChild) then
begin
Node.Sibling.btColor := rbRed;
Node.Parent.btColor := rbBlack;
end else begin
DeleteCase5(Node);
end;
end;
// Mirror image cases: Node's sibling is black, sibling's left child is red,
// sibling's right child is black, and Node is the left child. Swap the colors
// of sibling and its left sibling and rotate right at S
// And vice versa: Node's sibling is black, sibling's right child is red, sibling's
// left child is black, and Node is the right child of its parent. Swap the colors
// of sibling and its right sibling and rotate left at the sibling.
procedure TtdRedBlackTree.DeleteCase5(Node: PtdBinTreeNode);
begin
if Node.IsLeft and
IsBlack(Node.Sibling) and
IsRed(Node.Sibling.LeftChild) and
IsBlack(Node.Sibling.RightChild) then
begin
Node.Sibling.btColor := rbRed;
Node.Sibling.LeftChild.btColor := rbBlack;
RotateRight(Node.Sibling);
end else if Node.IsRight and
IsBlack(Node.Sibling) and
IsRed(Node.Sibling.RightChild) and
IsBlack(Node.Sibling.LeftChild) then
begin
Node.Sibling.btColor := rbRed;
Node.Sibling.RightChild.btColor := rbBlack;
RotateLeft(Node.Sibling);
end;
DeleteCase6(Node);
end;
// Mirror image cases:
// - "N's sibling S is black, S's right child is red, and N is the left child of its
// parent. We exchange the colors of N's parent and sibling, make S's right child
// black, then rotate left at N's parent.
// - N's sibling S is black, S's left child is red, and N is the right child of its
// parent. We exchange the colors of N's parent and sibling, make S's left child
// black, then rotate right at N's parent.
// This accomplishes three things at once:
// - We add a black node to all paths through N, either by adding a black S to those
// paths or by recoloring N's parent black.
// - We remove a black node from all paths through S's red child, either by removing
// P from those paths or by recoloring S.
// - We recolor S's red child black, adding a black node back to all paths through
// S's red child.
// S's left child has become a child of N's parent during the rotation and so is
// unaffected."
procedure TtdRedBlackTree.DeleteCase6(Node: PtdBinTreeNode);
begin
Node.Sibling.btColor := NodeColor(Node.Parent);
Node.Parent.btColor := rbBlack;
if Node.IsLeft then begin
assert(IsRed(Node.Sibling.RightChild));
Node.Sibling.RightChild.btColor := rbBlack;
RotateLeft(Node.Parent);
end else begin
assert(IsRed(Node.Sibling.LeftChild));
Node.Sibling.LeftChild.btColor := rbBlack;
RotateRight(Node.Parent);
end;
end;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With