这是着名作家在一本经常推荐的书中着名的实施.我觉得我应该使用它坚实的地面.但是我遇到使用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)为零,因此崩溃.检查树结构,节点的父节点是根节点,它显然具有一个零个父本身.
一些非工作的尝试修复它
我尝试简单地测试这个,只有当祖父母存在时才运行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()后,对Find()的调用正确返回nil,表示该项被删除.但是,循环的最后一次迭代,删除项目6导致TtdBinarySearchTree.bstFindItem中的崩溃：
Walker := FBinTree.Root; CmpResult := FCompare(aItem,Walker^.btData);
FBinTree.Root为零,调用FCompare时崩溃.
所以 – 在这一点上,我可以告诉我的修改显然只是造成更多的问题,而另一些更根本的是实现算法的代码是错误的.不幸的是,即使有这本书作为参考,我也不能弄清楚出了什么问题,或者说,正确的实现是什么样的,这里有什么不同.
我本来以为一直是我的代码不正确地使用树,导致问题.这还是很可能的！作者,这本书,因此隐含的代码在德尔福世界是众所周知的.但是崩溃是很容易重现的,使用从作者的网站下载的本书的源代码,为课程编写一些非常基本的单元测试.其他人也必须在过去十年的某个时候使用这个代码,并遇到同样的问题(除非是我的错误,我的代码和单元测试都使用不正确的树).我正在寻求帮助的答案：
>识别和修复“推广”和课堂其他地方的任何错误.请注意,我还为基类TtdBinarySearchTree编写了单元测试,并且全部通过. (这并不意味着它是完美的 – 我可能没有发现失败的案例,但这是一些帮助.)
>查找代码的更新版本.朱利安还没有发表任何errata for the red-black tree implementation.
>如果一切都失败,找到一个不同的,已知的很好的Delphi红黑树实现.我正在使用树来解决一个问题,而不是为了写一棵树.如果我不得不,我会很乐意用另一个(给定的许可条款等)来替换潜在的实现.然而,鉴于这本书和代码的谱系,问题是令人惊讶的,解决它们会帮助更多的人而不仅仅是我 – 这是一个广泛推荐的书在Delphi社区.
编辑：进一步说明
评论家MBo指出朱利安的EZDSL library,其中包含一个红黑树的另一个实现.该版本通过单元测试.我目前正在比较两个来源,试图看看算法偏离哪里,找出错误.
一种可能性是简单地使用EZDSL红黑树,而不是德尔福红黑树的Tomes,但图书馆有一些问题,使我不热衷于使用它：它仅用于32位x86;一些方法仅在汇编中提供,而不是Pascal(虽然大多数有两个版本);树结构完全不同,例如使用光标到节点而不是指针 – 一个完全有效的方法,但是代码与ToD书中的“示例”代码的不同之处的示例,其中导航在语义上是不同的;在我看来,代码很难理解和使用：它是非常重要的优化,变量和方法不如清楚地命名,有各种魔术功能,节点结构实际上是一个联合/案例记录,压缩详细的堆栈,队列,出列和列表,双链表,跳过列表,树,二进制树和堆在一个结构中几乎不可理解的调试器等.它不是代码我很想在生产中使用在哪里我需要支持它,也不容易学习. Delphi源代码的Tomes可读性更好,可维护性更高…但也不正确.你看到困境:)
我试图比较代码来尝试找到朱利安的实践代码(EZDSL)和他的教学代码(德尔福的Tomes)之间的区别.但是这个问题仍然是开放的,我仍然会感谢你的答案.自从发布以来的十二年里,我不可能是唯一一个使用来自德尔福的墓的红黑树的人:)
编辑：进一步说明
我已经回答了这个问题(尽管提供了一个赏金,哎呀),我很难通过检查代码和与算法的ToD描述进行比较来找到错误,所以我根据一个好的页面重新实现了有缺陷的方法描述了麻省理工学院许可的C实施的结构;详情如下.一个好处是,我认为新的实现实际上更清楚了解.
解决方法
注意事项：
>评论通常是页面对特定方法的解释的直接引用.
>这是很容易的移植,虽然我把程序化的C代码移植到面向对象的结构.有一些小小的怪癖,如Bucknall的树有一个fhead节点,孩子是树的根,你必须注意转换. (如果节点的父节点为NULL,则经常测试测试节点是根节点的方法,我已经将这个和其他类似的逻辑提取到帮助方法,或者节点或树方法).
>读者也可能发现Eternally Confuzzled page on red-black trees有用.虽然我在编写这个实现时没有使用它,但我可能应该有,如果在这个实现中有错误,我将转向那里了解.这也是我在调查ToD时研究RB树的第一个页面,提到红黑树和2-3-4 trees之间的连接名称.
>如果不清楚,这段代码修改了Delphi中的Tomes示例TtdBinaryTree,TtdBinarySearchTree和TtdRedBlackTree在TDBinTre.pas(source code download on the ToD page)中找到.要使用它,请编辑该文件.这不是一个新的实现,而是不完整的.具体来说,它保持ToD代码的结构,例如TtdBinarySearchTree不是TtdBinaryTree的后代,而是拥有一个作为成员(即包装它),使用fhead节点而不是Root的零父项等.
>原始代码是MIT许可的. (该网站正在转移到另一个许可证;它可能已经更改了您检查的时间.对于未来的读者,在撰写本文时,代码肯定是在麻省理工学院的许可证下.)我不确定对Tomes的许可的Delphi代码;因为它在一本算法书中,假设你可以使用它可能是合理的 – 它在参考书中是隐含的,我认为.就我而言,只要你符合原始许可证,欢迎使用它:)请留下评论,如果它是有用的,我想知道.
> Delphi实现的Tomes通过使用祖先排序的二叉树插入方法进行插入,然后“促进”节点.逻辑在这两个地方.该实现也实现插入,然后进入多个情况来检查位置并通过显式轮换进行修改.这些旋转是单独的方法(RotateLeft和RotateRight),我觉得很有用 – ToD代码谈论旋转,但没有明确地将它们拉到单独的命名方法.删除是类似的：它进入一些情况.每个案例都在页面上解释,并在我的代码中作为注释.其中一些我命名,但有些太复杂,不能放入一个方法名称,所以只是“案例4”,“案例5”等,并有注释解释.
>该页面还有代码来验证树的结构,以及红黑属性.我已经开始做这个作为单元测试的一部分,但还没有完全添加所有的红黑树约束,所以也添加了这个代码到树.它仅存在于调试版本中,并且断言如果出现错误,因此在调试中完成的单元测试将会遇到问题.
>树现在通过我的单元测试,虽然它们可以更广泛 – 我写了他们来调试Delphi树的Tomes更简单.此代码不作任何形式的担保或保证.考虑未经测试在使用之前先写测试.请注意,如果你发现一个错误:)
到代码！
节点修改
我向节点添加了以下帮助方法,以便在阅读时使代码更有文字性.例如,如果Node = Node.Parent.btChild [ctLeft]然后…,则原始代码通常通过测试(盲目转换为Delphi和未修改的ToD结构)来测试节点是否为其父级的左侧子节点,而现在您可以测试如果Node.IsLeft然后…等等.记录定义中的方法原型不包括在内,以节省空间,但应该是明显的:)
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()等额外的方法来测试它是否为黑色(如果IsBlack(Node)如果不是IsRed(Node)IsBlack(Node)),并且得到颜色,那么IMO代码扫描更好,包括处理一个nil节点请注意,这些需要保持一致 – 例如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代码中相同方法的直接转换.如果类定义中没有调试,则验证被声明为内联.如果没有调试,该方法应该是空的,希望可以被编译器完全删除.验证在插入和删除方法的开头和结尾调用,以确保修改前后的树是正确的.
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,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,PathBlackCount);
end;
旋转和其他有用的树方法
检查节点是否是根节点的帮助方法,将节点设置为根节点,用另一个节点替换一个节点,执行左右旋转,并按照右侧节点将树跟随到叶片.使这些受保护的红黑树类的成员.
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;
插入和删除
红黑树是内部树FBITree周围的包装.该代码以太连接的方式直接修改树. FBinTree和包装红黑树都保留了一个计数节点的数量,并使这个更清洁我删除了TtdBinarySearchTree(红黑树的祖先)的FCount并重定向了Count以返回FBinTree.Count,即询问二叉搜索树和红黑树类使用的实际内部树 – 这毕竟是拥有节点的东西.我还添加了NodeInserted和NodeRemoved的通知方法来增加和减少计数.代码不包括(微不足道).
我还提取了一些分配节点和处理节点的方法 – 不要从树中插入或删除,或者做任何关于节点的连接或存在的事情;这些是为了照顾节点本身的创建和销毁.请注意,节点创建需要将节点的颜色设置为红色 – 此点之后的颜色更改被照看.这也确保了节点被释放时,有机会释放与之相关联的数据.
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;
使用这些额外的方法,使用以下代码进行插入和删除.代码被评论,但是我建议您阅读original page以及德尔福的Tomes书籍,了解旋转的解释以及代码测试的各种情况.
插入
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;
最后的笔记
>我希望这是有用的！如果你发现它很有用,请留言说你如何使用它.我很想知道.>它不附带任何保证或保证.它通过我的单元测试,但它们可能更全面 – 我所能说的是,这个代码成功地在Delphi代码的Tomes失败了.谁知道是否以其他方式失败使用您自己的风险.我建议你为它编写测试.如果你发现错误,请在这里评论！有乐趣:)