Dav*_*vid 14 delphi algorithm tree red-black-tree
我正在使用Julian Bucknall在其着名的书" The Tomes Of Delphi"中编写的红黑树实现.源代码可以在这里下载,我在Delphi 2010中使用代码,并进行修改TdBasics.pas,让它在Delphi的现代版本中进行编译(主要是对大部分内容进行注释 - 树只需要一些定义)码.)
这是着名作家在一本经常推荐的书中的一个众所周知的实现.我觉得我应该坚持使用它.但我正在遇到使用Delete()和崩溃的崩溃Promote().回过头来用DUnit编写单元测试,这些问题很容易重现.一些示例代码是(来自我的DUnit测试的片段):
// 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;
我在算法中不够扎实,知道如何解决它而不引入进一步的问题(不平衡或不正确的树.)我知道,因为我已经尝试过:)
Promote()删除项目时,上述测试失败,标记为!!!:
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(成为aNode.btParent)nil,因此崩溃.检查树结构,节点的父节点是根节点,它显然有一个nil父节点.
我试过简单地测试这个,并且只在祖父母存在时运行if/then/else语句.虽然这似乎合乎逻辑,但这是一种天真的修复; 我不能很好地理解旋转,以确定这是否有效或者是否应该发生其他事情 - 这样做会导致另一个问题,在片段之后提到.(请注意,在上面复制的左侧旋转代码段下面有此代码的副本,同样也会出现相同的错误.)
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;
...
使用此代码,Delete的测试仍然失败,但有一些更奇怪的事情:在调用Delete()之后,对Find()的调用正确返回nil,表明项目已被删除.但是,循环的最后一次迭代(删除第6项)会导致崩溃TtdBinarySearchTree.bstFindItem:
Walker := FBinTree.Root;
CmpResult := FCompare(aItem, Walker^.btData);
FBinTree.Root是nil,在打电话时崩溃FCompare.
所以 - 在这一点上,我可以说我的修改显然只会导致更多的问题,而其他更基本的错误是实现算法的代码.不幸的是,即使以书作为参考,我也无法弄清楚出了什么问题,或者更确切地说,正确的实现是什么样的,这里有什么不同.
我原本以为它一定是我的代码错误地使用树,导致问题.这仍然是非常可能的!作者,本书以及隐含的代码在Delphi世界中都是众所周知的.但是崩溃很容易重现,使用从作者网站下载的书籍源代码,为课堂编写了一些非常基本的单元测试.其他人必须在过去十年中的某个时候也使用过此代码,并遇到了同样的问题(除非我的错误,我的代码和单元测试都错误地使用了树.)我正在寻求帮助的答案:
Promote课堂内和其他地方的任何错误.请注意,我还为基类编写了单元测试TtdBinarySearchTree,并且这些测试都通过了.(这并不意味着它是完美的 - 我可能没有找到失败的案例.但这是一些帮助.)Commenter MBo指出了Julian的EZDSL库,其中包含另一个红黑树的实现.此版本的单元测试通过.我目前正在比较这两个来源,试图找出算法的偏差,找到错误.
一种可能性是简单地使用EZDSL红黑树,而不是使用Delphi红黑树的Tomes,但是库中有一些问题让我不想使用它:它仅为32位x86编写; 一些方法仅在汇编中提供,而不是Pascal(尽管大多数都有两个版本); 树的结构完全不同,例如将游标用于节点而不是指针 - 这是一种非常有效的方法,但是代码与ToD书中"示例"代码有多么不同的例子,其中导航在语义上是不同的; 在我看来,代码更难以理解和使用:它经过了大量优化,变量和方法并没有明确命名,有各种魔术函数,节点结构实际上是一个联合/案例记录,压扁堆栈,队列,队列和列表,双链表,跳过列表,树,二叉树和堆的详细信息都在一个结构中,在调试器中几乎是不可理解的,等等.这不是我热衷于在生产中使用的代码在哪里我需要支持它,也不容易学习.Delphi的Tomes源代码更易读,更易于维护......但也不正确.你看到了两难的局面:)
我试图比较代码,试图找出朱利安的实践代码(EZDSL)和他的教学代码(德尔福的Tomes)之间的差异.但这个问题仍然是开放的,我仍然会感激答案.自发布以来的十二年里,我不能成为唯一一个使用德尔福Tomes的红黑树的人:)
我自己已经回答了这个问题(尽管提供了赏金.哎呀.)我很难通过检查代码和比较算法的ToD描述来找到错误,所以相反我基于一个好的页面重新实现了有缺陷的方法描述MIT许可的C实现带来的结构; 详情如下.一个好处是我认为新的实现实际上更清楚了解.
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,我发现的一棵红黑树中最明显的例子之一.(实际上,通过研究代码并验证它是否正确实现了某些错误,特别是当你不完全理解算法时,找到一个bug真的是一项艰巨的任务.我可以告诉你,我现在有了更好的理解!)树有很好的文档记录 - 我认为Delphi的Tomes可以更好地概述树的原因,但是这个代码是一个可读实现的更好的例子.
关于这个的说明:
FHead节点,其子节点是树的根,转换时你必须注意这一点.(测试经常测试节点的父节点是否为NULL,作为测试节点是否为根节点的一种方式.我已经将这个和其他类似的逻辑提取到辅助方法,或节点或树方法.)TtdBinaryTree,TtdBinarySearchTree并TtdRedBlackTree在TDBinTre.pas(ToD页面上的源代码下载)中找到.要使用它,请编辑该文件.它不是一个新的实现,并不是完整的.具体来说,它保留了ToD代码的结构,例如TtdBinarySearchTree不是TtdBinaryTree作为成员(即包装它)的后代,使用FHead节点而不是nil父节点Root等.RotateLeft和RotateRight),我认为这些方法很有用--ToD代码讨论了旋转但没有明确地将它们拉入单独的命名方法. Delete类似的:它涉及很多案例.每个案例都在页面上解释,并作为我的代码中的注释.其中一些我命名,但有些太复杂而无法放入方法名称,所以只是"案例4","案例5"等,并附有评论解释.关于代码!
我在节点中添加了以下辅助方法,以便在读取时使代码更有文化.例如,原始代码经常通过测试(盲目转换为Delphi和未修改的ToD结构)测试节点是否为其父节点的左子节点,if Node = Node.Parent.btChild[ctLeft] then...而现在您可以测试if Node.IsLeft then...等.记录定义中的方法原型不包括在内以保存空间,但应该是明显的:)
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;
我还添加了额外的方法,比如现有的IsRed(),测试它是否为黑色(IMO代码扫描更好,如果它if IsBlack(Node)没有if not IsRed(Node),并获得颜色,包括处理一个零节点.请注意,这些必须是一致的 - IsRed例如,返回对于nil节点为false,因此nil节点为黑色.(这也与红黑树的属性以及到叶子的路径上的黑色节点的数量一致.)
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;
如上所述,这些方法验证了树的结构和红黑约束,并且是原始C代码中相同方法的直接转换. Verify如果不在类定义中调试,则声明为内联.如果不是debug,则该方法应为空,并且希望编译器完全删除该方法. Verify在Insert和Delete方法的开头和结尾调用,以确保修改前后树是正确的.
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方法,用于检查节点是否为根节点,将节点设置为根节点,将一个节点替换为另一个节点,执行左右旋转,以及沿着右侧节点向下跟随树的叶子.将这些受保护的成员设为红黑树类.
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;