Tomes of Delphi のソース コードを調べて、アルゴリズムまたは Julian の他の実装、高度に最適化された EZDSL ライブラリの実装 (したがって、この質問!) と比較しても、何が問題なのかを突き止めることはできませんでしたが、代わりに再実装しましたDelete、および適切な測定のためInsertに、Literate Programming サイトの赤黒木のサンプル C コードに基づいています、私が見つけた赤黒木の最も明確な例の 1 つです。(特にアルゴリズムを完全に理解していない場合は特に、コードをすりつぶして何かを正しく実装していることを確認するだけでバグを見つけるのは、実際には非常に難しい作業です。私はあなたに言うことができます。私は今、はるかによく理解しています!)ツリーは非常によく文書化されています。Tomes of Delphi は、ツリーがそのように機能する理由のより良い概要を示していると思いますが、このコードは読みやすい実装のより良い例です。
これに関する注意事項:
- コメントは、多くの場合、特定のメソッドに関するページの説明から直接引用されています。
- 手続き型の C コードをオブジェクト指向構造に移動しましたが、移植は非常に簡単でした。
FHeadBucknall ツリーにはノードがあり、その子はツリーのルートであり、変換するときに注意する必要があるなど、いくつかの小さな癖があります。(ノードがルート ノードであるかどうかをテストする方法として、ノードの親が NULL であるかどうかをテストすることがよくあります。これと他の同様のロジックをヘルパー メソッド、ノードまたはツリー メソッドに抽出しました。)
- 読者は、赤黒木に関する Eternally Confuzzled のページも役に立つかもしれません。この実装を書いているときは使用しませんでしたが、おそらく使用する必要がありました。この実装にバグがある場合は、洞察を得るためにそこに目を向けます。また、ToD ツリーをデバッグするときに RB ツリーを調査しているときに見つけた最初のページでもあり、名前で赤黒ツリーと2-3-4 ツリーの間の接続に言及していました。
- 不明な点がある場合、このコードは Tomes of Delphi の例を変更したもの
TtdBinaryTreeで、TtdBinarySearchTree( ToDページのソース コード ダウンロード) にあります。これを使用するには、そのファイルを編集します。これは新しい実装ではなく、それ自体では完全ではありません。具体的には、 ToD コードの構造を保持します。たとえば、 の子孫ではなく、メンバーとして所有する (つまり、ラップする)、nil の親の代わりにノードを使用するなどです。TtdRedBlackTreeTDBinTre.pasTtdBinarySearchTreeTtdBinaryTreeFHeadRoot
- オリジナルのコードは MIT ライセンスです。(サイトは別のライセンスに移行しています。チェックするまでに変更されている可能性があります。将来の読者のために、この記事の執筆時点では、コードは間違いなく MIT ライセンスの下にありました。) Delphi コードの; アルゴリズムの本に載っているので、それを使用できると仮定するのはおそらく合理的です - 参考書には暗示されていると思います。私に関する限り、元のライセンスに準拠している限り、それを使用することは大歓迎です :) 有用な場合はコメントを残してください。知りたいです。
- Tomes of Delphi の実装は、祖先のソートされたバイナリ ツリーの挿入メソッドを使用して挿入し、ノードを「プロモート」することによって機能します。ロジックは、これら 2 つの場所のいずれかにあります。この実装は挿入も実装し、その後、いくつかのケースに入って位置を確認し、明示的な回転によって位置を変更します。これらのローテーションは別のメソッド (
RotateLeftおよびRotateRight) にあり、これは便利だと思います。ToD コードはローテーションについて説明していますが、明示的に別の名前付きメソッドにプルしていません。 Delete似ています。多くの場合に当てはまります。各ケースはページで説明されており、私のコードではコメントとして説明されています。私が名前を付けたものもあれば、複雑すぎてメソッド名を付けられないものもあるため、「ケース 4」、「ケース 5」などとコメントで説明しています。
- このページには、ツリーの構造と赤黒のプロパティを確認するためのコードも含まれていました。単体テストの作成の一環としてこれを開始しましたが、まだすべての赤黒ツリー制約を完全に追加していなかったので、このコードもツリーに追加しました。これはデバッグ ビルドにのみ存在し、何か問題がある場合はアサートするため、デバッグで実行される単体テストで問題が検出されます。
- ツリーは私の単体テストに合格するようになりましたが、もっと大規模なものになる可能性があります。Tomes of Delphi ツリーのデバッグをより簡単にするためにそれらを書きました。このコードには、いかなる種類の保証も保証もありません。テストされていないと考えてください。使用する前にテストを作成します。バグを見つけたらコメントしてください:)
コードに！
ノードの変更
次のヘルパー メソッドをノードに追加して、読み取り時にコードをより読みやすくしました。たとえば、元のコードでは、ノードがその親の左の子であるかどうかをテスト (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;
また、既存の のような追加のメソッドを追加して、それが黒であるかどうかをテストします (IMO コードは、そうでないIsRed()場合はより適切にスキャンし、nil ノードの処理を含む色を取得します。これらは一貫している必要があることに注意してください。たとえば、 を返しますnil ノードの場合は false であるため、nil ノードは黒です (これは、赤黒ツリーのプロパティ、および葉へのパス上の黒ノードの一貫した数とも関連しています)。if IsBlack(Node)if not IsRed(Node)IsRed
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クラス定義でデバッグしない場合、インラインとして宣言されます。デバッグしない場合、メソッドは空である必要があり、コンパイラによって完全に削除されることを願っています。 andメソッドVerifyの最初と最後に呼び出され、変更の前後でツリーが正しいことを確認します。InsertDelete
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;
回転およびその他の便利なツリー メソッド
ノードがルート ノードであるかどうかをチェックし、ノードをルートとして設定し、あるノードを別のノードに置き換え、左右の回転を実行し、右側のノードからリーフまでツリーをたどるヘルパー メソッド。これらの保護されたメンバーを赤黒木クラスにします。
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;
挿入と削除
赤黒ツリーは、内部ツリーのラッパーFBinTreeです。このコードはあまりにも関連した方法でツリーを直接変更します。FBinTreeラッパーの赤黒ツリーの両方FCountがノード数のカウントを保持し、これをよりクリーンにするために、TtdBinarySearchTree(赤黒ツリーの祖先)を削除し、returnにFCountリダイレクトしました。つまり、実際の内部ツリーにバイナリを要求します。検索ツリーと赤黒ツリー クラスが使用する - これは結局、ノードを所有するものです。また、通知メソッドを追加し、カウントをインクリメントおよびデクリメントします。コードは含まれていません (自明)。CountFBinTree.CountNodeInsertedNodeRemoved
また、ノードを割り当ててノードを破棄するためのいくつかのメソッドを抽出しました。ツリーから挿入または削除したり、ノードの接続や存在について何かを行ったりすることはありません。これらは、ノード自体の作成と破棄を管理します。ノードの作成では、ノードの色を赤に設定する必要があることに注意してください。色の変更は、この時点以降に行われます。これにより、ノードが解放されたときに、それに関連付けられたデータを解放する機会が確実に得られます。
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;
これらの追加メソッドでは、挿入と削除に次のコードを使用します。コードにはコメントが付けられていますが、ローテーションの説明とコードがテストするさまざまなケースについては、元のページと Tomes of Delphi の本を読むことをお勧めします。
挿入
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;
最終的な注意事項
- これが役に立つことを願っています！役に立ったと感じた場合は、どのように使用したかをコメントに残してください。知りたいです。
- いかなる保証も保証もありません。それは私の単体テストに合格しますが、もっと包括的である可能性があります。私が本当に言えるのは、Tomes of Delphi コードが失敗したところで、このコードが成功したということだけです。他の方法で失敗するかどうかは誰にもわかりません。自己責任。そのためのテストを書くことをお勧めします。バグを見つけた場合は、ここにコメントしてください。
- 楽しむ ：）