GitHub-Mirror/x2utils
1
0
Fork 0
mirror of synced 2024-09-19 09:46:09 +00:00
Code Issues Projects Releases Wiki Activity

Fixed: binary tree deletion

Browse Source
This commit is contained in:
Mark van Renswoude 2005-01-12 13:06:05 +00:00
parent 0820da418a
commit 48f62eeab7
2 changed files with 154 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
UnitTests/Units/UTrees.pas
View File

@ -102,8 +102,25 @@ begin
// 16 // 16
// 5 25 // 5 25
// 1 // 1
//FTree.Delete(10); FTree.Delete(10);
//CheckTree('16-5-1-25'); CheckTree('16-5-1-25');
// 16
// 1 25
FTree.Delete(5);
CheckTree('16-1-25');
// 16
// 1
FTree.Delete(25);
CheckTree('16-1');
// 1
FTree.Delete(16);
CheckTree('1');
FTree.Delete(1);
CheckTree('');
CustomTearDown(); CustomTearDown();
end; end;

211
X2UtTrees.pas
View File

@ -21,13 +21,22 @@ type
* who their parent is. It costs 4 bytes... but that's only 4 megabytes * who their parent is. It costs 4 bytes... but that's only 4 megabytes
* overhead for each million nodes, not much of a burden nowadays. * overhead for each million nodes, not much of a burden nowadays.
*} *}
RX2BTNode = ^PX2BTNode; TX2BTLinks = array[0..11] of Byte;
PX2BTNode = ^TX2BTNode; PX2BTNode = ^TX2BTNode;
TX2BTNode = record TX2BTNode = record
Key: Cardinal; Key: Cardinal;
Parent: PX2BTNode;
Left: PX2BTNode; case Boolean of
Right: PX2BTNode; True:
(
Parent: PX2BTNode;
Left: PX2BTNode;
Right: PX2BTNode;
);
False:
(
Links: TX2BTLinks;
);
end; end;
@ -37,17 +46,17 @@ type
*} *}
TX2BTCustomCursor = class(TObject) TX2BTCustomCursor = class(TObject)
private private
FRoot: RX2BTNode; FRoot: PX2BTNode;
protected protected
function GetCurrentNode(): RX2BTNode; virtual; abstract; function GetCurrentNode(): PX2BTNode; virtual; abstract;
function GetEof(): Boolean; virtual; abstract; function GetEof(): Boolean; virtual; abstract;
public public
constructor Create(const ARoot: RX2BTNode); virtual; constructor Create(const ARoot: PX2BTNode); virtual;
procedure First(); virtual; abstract; procedure First(); virtual; abstract;
procedure Next(); virtual; abstract; procedure Next(); virtual; abstract;
property CurrentNode: RX2BTNode read GetCurrentNode; property CurrentNode: PX2BTNode read GetCurrentNode;
property Eof: Boolean read GetEof; property Eof: Boolean read GetEof;
end; end;
@ -61,9 +70,9 @@ type
*} *}
TX2BTDefaultCursor = class(TX2BTCustomCursor) TX2BTDefaultCursor = class(TX2BTCustomCursor)
private private
FNode: RX2BTNode; FNode: PX2BTNode;
protected protected
function GetCurrentNode(): RX2BTNode; override; function GetCurrentNode(): PX2BTNode; override;
function GetEof(): Boolean; override; function GetEof(): Boolean; override;
public public
procedure First(); override; procedure First(); override;
@ -80,29 +89,31 @@ type
private private
FCursor: TX2BTCustomCursor; FCursor: TX2BTCustomCursor;
FRoot: PX2BTNode; FRoot: PX2BTNode;
FLastNode: RX2BTNode; FLastNode: PX2BTNode;
function GetRoot(): RX2BTNode;
function GetCurrentKey(): Cardinal; function GetCurrentKey(): Cardinal;
function GetEof(): Boolean; function GetEof(): Boolean;
protected protected
procedure CursorNeeded(); procedure CursorNeeded();
procedure InvalidateCursor();
property Root: RX2BTNode read GetRoot; //property Root: PX2BTNode read FRoot write FRoot;
protected protected
// Methods which don't really need to be virtual // Methods which don't really need to be virtual
// (if you have a good reason; share it with me so I can make it // (if you have a good reason; share it with me so I can make it
// virtual, until then it's kept normal for performance reasons) // virtual, until then it's kept normal for performance reasons)
procedure ClearNodes(); procedure ClearNodes();
function FindLowestNode(const ANode: RX2BTNode): RX2BTNode; function FindLowestNode(const ANode: PX2BTNode): PX2BTNode;
function FindHighestNode(const ANode: RX2BTNode): RX2BTNode; function FindHighestNode(const ANode: PX2BTNode): PX2BTNode;
function FindNode(const AKey: Cardinal; out AParent: RX2BTNode): RX2BTNode; function FindNode(const AKey: Cardinal; out AParent: PX2BTNode): PX2BTNode;
function FindNodeOnly(const AKey: Cardinal): RX2BTNode; function FindNodeOnly(const AKey: Cardinal): PX2BTNode;
function LeftChild(const ANode: PX2BTNode): Boolean; function LeftChild(const ANode: PX2BTNode): Boolean;
function RightChild(const ANode: PX2BTNode): Boolean; function RightChild(const ANode: PX2BTNode): Boolean;
procedure SwapNodes(const ANode1, ANode2: PX2BTNode);
// Virtual methods (commonly needed in descendants) // Virtual methods (commonly needed in descendants)
function GetCursorClass(): TX2BTCursorClass; virtual; function GetCursorClass(): TX2BTCursorClass; virtual;
@ -112,7 +123,7 @@ type
procedure InsertNode(const AKey: Cardinal); virtual; procedure InsertNode(const AKey: Cardinal); virtual;
procedure DeleteNode(const AKey: Cardinal); virtual; procedure DeleteNode(const AKey: Cardinal); virtual;
procedure DeleteCleanNode(const ANode: PX2BTNode); virtual; procedure DeleteCleanNode(var ANode: PX2BTNode); virtual;
public public
constructor Create(); virtual; constructor Create(); virtual;
destructor Destroy(); override; destructor Destroy(); override;
@ -173,9 +184,6 @@ type
end; end;
implementation implementation
uses
Dialogs;
resourcestring resourcestring
RSBTKeyExists = 'The key "%d" already exists in the tree.'; RSBTKeyExists = 'The key "%d" already exists in the tree.';
RSBTKeyNotFound = 'The key "%d" could not be found in the tree.'; RSBTKeyNotFound = 'The key "%d" could not be found in the tree.';
@ -210,25 +218,25 @@ begin
if Eof then if Eof then
raise EBTCursorEof.Create(RSBTCursorEof); raise EBTCursorEof.Create(RSBTCursorEof);
if Assigned(FNode^^.Left) then if Assigned(FNode^.Left) then
// Node has a left child // Node has a left child
FNode := @FNode^^.Left FNode := FNode^.Left
else if Assigned(FNode^^.Right) then else if Assigned(FNode^.Right) then
// Node has a right child // Node has a right child
FNode := @FNode^^.Right FNode := FNode^.Right
else else
begin begin
// Traverse up the path. If we encounter a left direction, it means we // Traverse up the path. If we encounter a left direction, it means we
// can attempt to search the right part of that parent node. // can attempt to search the right part of that parent node.
repeat repeat
pChild := FNode^; pChild := FNode;
FNode := @FNode^^.Parent; FNode := FNode^.Parent;
if Assigned(FNode^) then if Assigned(FNode) then
begin begin
if (FNode^^.Left = pChild) and Assigned(FNode^^.Right) then if (FNode^.Left = pChild) and Assigned(FNode^.Right) then
begin begin
FNode := @FNode^^.Right; FNode := FNode^.Right;
break; break;
end; end;
end else end else
@ -248,7 +256,7 @@ end;
function TX2BTDefaultCursor.GetEof; function TX2BTDefaultCursor.GetEof;
begin begin
Result := (not Assigned(FNode)) or (not Assigned(FNode^)); Result := not Assigned(FNode);
end; end;
@ -279,7 +287,7 @@ end;
function TX2BinaryTree.Exists; function TX2BinaryTree.Exists;
begin begin
Result := Assigned(FindNodeOnly(AKey)^); Result := Assigned(FindNodeOnly(AKey));
end; end;
procedure TX2BinaryTree.Insert; procedure TX2BinaryTree.Insert;
@ -313,14 +321,10 @@ procedure TX2BinaryTree.AllocateNode;
begin begin
GetMem(ANode, SizeOf(TX2BTNode)); GetMem(ANode, SizeOf(TX2BTNode));
FillChar(ANode^, SizeOf(TX2BTNode), #0); FillChar(ANode^, SizeOf(TX2BTNode), #0);
ShowMessage('Allocating: ' + IntToStr(Integer(ANode)));
end; end;
procedure TX2BinaryTree.DeallocateNode; procedure TX2BinaryTree.DeallocateNode;
begin begin
ShowMessage('Deallocating: ' + IntToStr(Integer(ANode)));
FreeMem(ANode, SizeOf(TX2BTNode)); FreeMem(ANode, SizeOf(TX2BTNode));
ANode := nil; ANode := nil;
end; end;
@ -332,7 +336,7 @@ var
pParent: PX2BTNode; pParent: PX2BTNode;
begin begin
pNode := Root^; pNode := FRoot;;
while Assigned(pNode) do while Assigned(pNode) do
begin begin
@ -361,7 +365,7 @@ begin
end; end;
FLastNode := nil; FLastNode := nil;
Root^ := nil; FRoot := nil;
end; end;
@ -369,23 +373,25 @@ function TX2BinaryTree.FindHighestNode;
begin begin
Result := ANode; Result := ANode;
while Assigned(Result^) and Assigned(Result^^.Right) do while Assigned(Result) and Assigned(Result^.Right) do
Result := @Result^^.Right; Result := Result^.Right;
end; end;
function TX2BinaryTree.FindLowestNode; function TX2BinaryTree.FindLowestNode;
begin begin
Result := ANode; Result := ANode;
while Assigned(Result^) and Assigned(Result^^.Left) do while Assigned(Result) and Assigned(Result^.Left) do
Result := @Result^^.Left; Result := Result^.Left;
end; end;
function TX2BinaryTree.FindNode; function TX2BinaryTree.FindNode;
var
pNode: PX2BTNode;
begin begin
// Quick check; was this node found previously // Quick check; was this node found previously
if Assigned(FLastNode) and Assigned(FLastNode^) and if Assigned(FLastNode) and (FLastNode^.Key = AKey) then
(FLastNode^^.Key = AKey) then
begin begin
Result := FLastNode; Result := FLastNode;
exit; exit;
@ -393,28 +399,31 @@ begin
AParent := nil; AParent := nil;
FLastNode := nil; FLastNode := nil;
Result := nil;
pNode := FRoot;
Result := Root; while Assigned(pNode) do
while Assigned(Result^) do if AKey = pNode^.Key then
if AKey = Result^^.Key then
break
else
begin begin
AParent := Result; Result := pNode;
break;
end else
begin
AParent := pNode;
if AKey < Result^^.Key then if AKey < pNode^.Key then
Result := @Result^^.Left pNode := pNode^.Left
else else
Result := @Result^^.Right; pNode := pNode^.Right;
end; end;
if Assigned(Result^) then if Assigned(Result) then
FLastNode := Result; FLastNode := Result;
end; end;
function TX2BinaryTree.FindNodeOnly; function TX2BinaryTree.FindNodeOnly;
var var
pDummy: RX2BTNode; pDummy: PX2BTNode;
begin begin
Result := FindNode(AKey, pDummy); Result := FindNode(AKey, pDummy);
@ -433,34 +442,81 @@ begin
end; end;
procedure TX2BinaryTree.SwapNodes;
procedure FixLinks(const ANode, AOld: PX2BTNode);
begin
if Assigned(ANode^.Parent) then
if ANode^.Parent^.Left = AOld then
ANode^.Parent^.Left := ANode
else
ANode^.Parent^.Right := ANode;
if Assigned(ANode^.Left) then
ANode^.Left^.Parent := ANode;
if Assigned(ANode^.Right) then
ANode^.Right^.Parent := ANode;
end;
var
pBuffer: TX2BTLinks;
begin
pBuffer := ANode1.Links;
ANode1.Links := ANode2.Links;
ANode2.Links := pBuffer;
FixLinks(ANode1, ANode2);
FixLinks(ANode2, ANode1);
if FRoot = ANode1 then
FRoot := ANode2
else if FRoot = ANode2 then
FRoot := ANode1;
end;
procedure TX2BinaryTree.InsertNode; procedure TX2BinaryTree.InsertNode;
var var
pNode: RX2BTNode; pNode: PX2BTNode;
pParent: RX2BTNode; pParent: PX2BTNode;
begin begin
pNode := FindNode(AKey, pParent); pNode := FindNode(AKey, pParent);
if Assigned(pNode^) then if Assigned(pNode) then
raise EBTKeyExists.CreateFmt(RSBTKeyExists, [AKey]); raise EBTKeyExists.CreateFmt(RSBTKeyExists, [AKey]);
AllocateNode(pNode^); InvalidateCursor();
AllocateNode(pNode);
FLastNode := pNode; FLastNode := pNode;
pNode^^.Key := AKey; if not Assigned(FRoot) then
FRoot := pNode;
pNode^.Key := AKey;
if Assigned(pParent) then if Assigned(pParent) then
pNode^^.Parent := pParent^; begin
pNode^.Parent := pParent;
if AKey < pParent^.Key then
pParent^.Left := pNode
else
pParent^.Right := pNode;
end;
end; end;
procedure TX2BinaryTree.DeleteNode; procedure TX2BinaryTree.DeleteNode;
var var
pNode: RX2BTNode; pNode: PX2BTNode;
pLowest: PX2BTNode;
begin begin
//! Implement DeleteNode
pNode := FindNodeOnly(AKey); pNode := FindNodeOnly(AKey);
if not Assigned(pNode^) then if not Assigned(pNode) then
raise EBTKeyNotFound.CreateFmt(RSBTKeyNotFound, [AKey]); raise EBTKeyNotFound.CreateFmt(RSBTKeyNotFound, [AKey]);
InvalidateCursor();
// If the node to be deleted has either one or no branch, it can simply be // If the node to be deleted has either one or no branch, it can simply be
// taken out of the chain. If it has two branches, find the lowest key on // taken out of the chain. If it has two branches, find the lowest key on
// the right branch and swap it. // the right branch and swap it.
@ -472,13 +528,14 @@ begin
// 2 5 | >>> 2 5 // 2 5 | >>> 2 5
// 1 3 4 6 | 1 3 6 // 1 3 4 6 | 1 3 6
// +----+ // +----+
if Assigned(pNode^^.Left) and Assigned(pNode^^.Right) then if Assigned(pNode^.Left) and Assigned(pNode^.Right) then
begin begin
exit; pLowest := FindLowestNode(pNode^.Right);
SwapNodes(pNode, pLowest);
end; end;
// At this point, the node is a leaf node or has only one branch // At this point, the node is a leaf node or has only one branch
DeleteCleanNode(pNode^); DeleteCleanNode(pNode);
end; end;
procedure TX2BinaryTree.DeleteCleanNode; procedure TX2BinaryTree.DeleteCleanNode;
@ -510,15 +567,22 @@ begin
if Assigned(pChild) then if Assigned(pChild) then
pChild^.Parent := pParent; pChild^.Parent := pParent;
pChild := ANode; if ANode = FRoot then
DeallocateNode(pChild); FRoot := pChild;
DeallocateNode(ANode);
end; end;
procedure TX2BinaryTree.CursorNeeded; procedure TX2BinaryTree.CursorNeeded;
begin begin
if not Assigned(FCursor) then if not Assigned(FCursor) then
FCursor := GetCursorClass().Create(Root); FCursor := GetCursorClass().Create(FRoot);
end;
procedure TX2BinaryTree.InvalidateCursor;
begin
FreeAndNil(FCursor);
end; end;
@ -528,17 +592,12 @@ begin
end; end;
function TX2BinaryTree.GetRoot;
begin
Result := @FRoot;
end;
function TX2BinaryTree.GetCurrentKey; function TX2BinaryTree.GetCurrentKey;
begin begin
if Eof then if Eof then
raise EBTCursorEof.Create(RSBTCursorEof); raise EBTCursorEof.Create(RSBTCursorEof);
Result := FCursor.CurrentNode^^.Key; Result := FCursor.CurrentNode^.Key;
end; end;
function TX2BinaryTree.GetEof; function TX2BinaryTree.GetEof;