该页面还有验证树结构和红黑属性的代码。我开始作为编写单元测试的一部分而这样
开始编写代码吧！
节点修改
我添加了以下助手方法到节点中，使得代码在阅读时更易理解。例如，原始代码经常通过测试 (盲目转换为 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');
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()，用于测试它是否为黑色（我的代码扫描更好，如果它说if IsBlack(Node)而不是if not IsRed(Node)），以及获取颜色，包括处理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代码中的相同方法。如果在类定义中未调试，则Verify声明为内联。如果没有调试，则该方法应为空，希望编译器完全删除它。Verify在Insert和Delete方法的开头和结尾被调用，以确保修改前后树的正确性。
procedure TtdRedBlackTree.Verify;
begin
{$ifdef DEBUG}
VerifyNodesRedOrBlack(FBinTree.Root);
VerifyRootIsBlack;
VerifyRedBlackRelationship(FBinTree.Root);
VerifyBlackNodeCount(FBinTree.Root);
{$endif}
end;
procedure TtdRedBlackTree.VerifyNodesRedOrBlack(const Node : PtdBinTreeNode);
begin
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
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
PathBlackCount := -1;
VerifyBlackNodeCountHelper(Node, 0, 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
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;
FBinTree.SetRoot(Node);
Node.btParent.btColor := rbBlack;
end;
function TtdRedBlackTree.MaximumNode(Node: PtdBinTreeNode): PtdBinTreeNode;
begin
assert(Node <> nil);
while Node.RightChild <> nil do begin
Node := Node.RightChild;
end;
Result := Node;
end;
插入和删除
红黑树是一个内部树FBinTree的封装。这段代码直接修改了树，使其过于紧密连接。二叉搜索树和红黑树类都保留了节点数计数器FCount。为了使代码更简洁，我删除了红黑树祖先TtdBinarySearchTree的FCount并将Count重定向到FBinTree.Count，即询问实际的内部树，这是二叉搜索树和红黑树类使用的东西 - 它毕竟拥有节点。我还添加了通知方法NodeInserted和NodeRemoved来增加和减少计数。代码未包含（微不足道）。
我还提取了一些用于分配节点和释放节点的方法 - 不是为了插入或从树中删除，也不是为了处理节点的连接或存在；而是为了照顾节点本身的创建和销毁。请注意，节点创建需要将节点的颜色设置为红色 - 颜色变化在此之后进行处理。这还确保在释放节点时，有机会释放与其关联的数据。
function TtdBinaryTree.NewNode(const Item : Pointer): PtdBinTreeNode;
begin
Result := BTNodeManager.AllocNode;
Result^.btParent := nil;
Result^.btChild[ctLeft] := nil;
Result^.btChild[ctRight] := nil;
Result^.btData := Item;
Result.btColor := rbRed;
end;
procedure TtdBinaryTree.DisposeNode(Node: PtdBinTreeNode);
begin
if Assigned(FDispose) then FDispose(Node.btData);
BTNodeManager.FreeNode(Node);
NodeRemoved;
end;
使用这些额外的方法，可以使用以下代码进行插入和删除。代码已经注释，但我建议您阅读原始页面以及Tom的Delphi书籍，以了解旋转的说明，代码测试的各种情况。
插入
procedure TtdRedBlackTree.Insert(aItem : pointer);
var
NewNode, Node : PtdBinTreeNode;
Comparison : NativeInt;
begin
Verify;
newNode := FBinTree.NewNode(aItem);
assert(IsRed(NewNode));
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
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;
NodeInserted;
end;
InsertCase1(NewNode);
Verify;
end;
procedure TtdRedBlackTree.InsertCase1(Node: PtdBinTreeNode);
begin
if not IsRoot(Node) then begin
InsertCase2(Node);
end else begin
Node.btColor := rbBlack;
end;
end;
procedure TtdRedBlackTree.InsertCase2(Node: PtdBinTreeNode);
begin
if not IsBlack(Node.Parent) then InsertCase3(Node);
end;
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;
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;
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;
Deletion
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;
procedure TtdRedBlackTree.DeleteCase1(Node: PtdBinTreeNode);
begin
if IsRoot(Node) then Exit;
DeleteCase2(Node);
end;
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;
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;
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;
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;
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;
最后说明
- 希望这篇翻译对您有所帮助! 如果您发现它有用，请留下评论告诉我您如何使用它，我很想知道。
- 本代码没有任何担保或保证。它通过了我的单元测试，但测试可能不够全面-我只能说这段代码可以成功地执行Tomes of Delphi代码无法执行的任务。其他方面是否失败还未可知。请自行决定是否使用，我建议您为其编写测试。如果您发现错误，请在此处发表评论！
- 祝您使用愉快 :)
