Merged: avltree branch
This commit is contained in:
parent
d3ae64e43d
commit
b105c57f5b
33
Test/Forms/FBTree.dfm
Normal file
33
Test/Forms/FBTree.dfm
Normal file
@ -0,0 +1,33 @@
|
||||
object frmBTree: TfrmBTree
|
||||
Left = 199
|
||||
Top = 107
|
||||
Width = 603
|
||||
Height = 410
|
||||
Caption = 'Binary Tree Debug'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object ocTree: TdxOrgChart
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 595
|
||||
Height = 383
|
||||
DefaultNodeWidth = 50
|
||||
BorderStyle = bsNone
|
||||
Options = [ocSelect, ocRect3D]
|
||||
Align = alClient
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
ParentColor = True
|
||||
OnDblClick = ocTreeDblClick
|
||||
end
|
||||
end
|
||||
129
Test/Forms/FBTree.pas
Normal file
129
Test/Forms/FBTree.pas
Normal file
@ -0,0 +1,129 @@
|
||||
unit FBTree;
|
||||
|
||||
interface
|
||||
uses
|
||||
Forms,
|
||||
Classes,
|
||||
Controls,
|
||||
Windows,
|
||||
dxorgchr,
|
||||
X2UtBinaryTree;
|
||||
|
||||
type
|
||||
TfrmBTree = class(TForm)
|
||||
ocTree: TdxOrgChart;
|
||||
procedure ocTreeDblClick(Sender: TObject);
|
||||
private
|
||||
FTree: TX2UtCustomBTree;
|
||||
protected
|
||||
procedure BuildTree(const ARoot: PX2UtBTreeNode;
|
||||
const AParent: TdxOcNode = nil);
|
||||
public
|
||||
class procedure Execute(const ATree: TX2UtCustomBTree;
|
||||
const AShowModal: Boolean = True);
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Graphics,
|
||||
SysUtils,
|
||||
TypInfo;
|
||||
|
||||
type
|
||||
THackBTree = class(TX2UtCustomBTree);
|
||||
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
class procedure TfrmBTree.Execute;
|
||||
begin
|
||||
with TfrmBTree.Create(nil) do
|
||||
try
|
||||
FTree := ATree;
|
||||
BuildTree(THackBTree(ATree).Root);
|
||||
|
||||
if Assigned(ocTree.RootNode) then
|
||||
ocTree.RootNode.Expand(True);
|
||||
|
||||
if AShowModal then
|
||||
ShowModal()
|
||||
else
|
||||
Show();
|
||||
finally
|
||||
// Yes, yes, memory leak I know. Should have an owner of something. Anyways,
|
||||
// I'm too lazy to fix it in this test application...
|
||||
if AShowModal then
|
||||
Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmBTree.BuildTree;
|
||||
function CreateTextNode(const AParent: TdxOcNode;
|
||||
const AText: String): TdxOcNode;
|
||||
begin
|
||||
Result := ocTree.AddChild(AParent, nil);
|
||||
Result.Text := AText;
|
||||
Result.Color := clInfoBk;
|
||||
end;
|
||||
|
||||
function CreateNode(const AParent: TdxOcNode;
|
||||
const ANode: PX2UtBTreeNode): TdxOcNode;
|
||||
begin
|
||||
Result := CreateTextNode(AParent, IntToStr(ANode^.Index) + #13#10 +
|
||||
IntToStr(ANode^.Balance));
|
||||
Result.Data := ANode;
|
||||
end;
|
||||
|
||||
var
|
||||
pNode: TdxOcNode;
|
||||
pLeft: TdxOcNode;
|
||||
pRight: TdxOcNode;
|
||||
|
||||
begin
|
||||
if not Assigned(ARoot) then
|
||||
exit;
|
||||
|
||||
pLeft := nil;
|
||||
pRight := nil;
|
||||
|
||||
if not Assigned(AParent) then
|
||||
pNode := CreateNode(nil, ARoot)
|
||||
else
|
||||
pNode := AParent;
|
||||
|
||||
if Assigned(ARoot^.Children[0]) then
|
||||
pLeft := CreateNode(pNode, ARoot^.Children[0])
|
||||
else if Assigned(ARoot^.Children[1]) then
|
||||
CreateTextNode(pNode, '<nil>');
|
||||
|
||||
if Assigned(ARoot^.Children[1]) then
|
||||
pRight := CreateNode(pNode, ARoot^.Children[1])
|
||||
else if Assigned(ARoot^.Children[0]) then
|
||||
CreateTextNode(pNode, '<nil>');
|
||||
|
||||
if Assigned(ARoot^.Children[0]) then
|
||||
BuildTree(ARoot^.Children[0], pLeft);
|
||||
|
||||
if Assigned(ARoot^.Children[1]) then
|
||||
BuildTree(ARoot^.Children[1], pRight);
|
||||
end;
|
||||
|
||||
procedure TfrmBTree.ocTreeDblClick;
|
||||
var
|
||||
pNode: TdxOcNode;
|
||||
|
||||
begin
|
||||
pNode := ocTree.Selected;
|
||||
|
||||
if Assigned(pNode) and Assigned(pNode.Data) then
|
||||
begin
|
||||
FTree.Delete(PX2UtBTreeNode(pNode.Data)^.Index);
|
||||
ocTree.Clear();
|
||||
|
||||
BuildTree(THackBTree(FTree).Root);
|
||||
if Assigned(ocTree.RootNode) then
|
||||
ocTree.RootNode.Expand(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -32,6 +32,6 @@
|
||||
-M
|
||||
-$M16384,1048576
|
||||
-K$00400000
|
||||
-LE"c:\program files\borland\delphi6\Projects\Bpl"
|
||||
-LN"c:\program files\borland\delphi6\Projects\Bpl"
|
||||
-LE"c:\delphi6\Projects\Bpl"
|
||||
-LN"c:\delphi6\Projects\Bpl"
|
||||
-DmadExcept
|
||||
|
||||
@ -46,7 +46,7 @@ UnitOutputDir=
|
||||
PackageDLLOutputDir=
|
||||
PackageDCPOutputDir=
|
||||
SearchPath=
|
||||
Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter
|
||||
Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter;dxorgcD6
|
||||
Conditionals=madExcept
|
||||
DebugSourceDirs=
|
||||
UsePackages=0
|
||||
@ -56,6 +56,10 @@ HostApplication=
|
||||
Launcher=
|
||||
UseLauncher=0
|
||||
DebugCWD=
|
||||
[Language]
|
||||
ActiveLang=
|
||||
ProjectLang=
|
||||
RootDir=
|
||||
[Version Info]
|
||||
IncludeVerInfo=0
|
||||
AutoIncBuild=0
|
||||
@ -184,16 +188,7 @@ c:\program files\borland\delphi6\Bin\dclwebsnap60.bpl=Borland WebSnap Components
|
||||
c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment
|
||||
c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components
|
||||
c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components
|
||||
[Included Packages]
|
||||
C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components
|
||||
c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements
|
||||
C:\Program Files\Borland\Delphi6\Bin\dcldb60.bpl=Borland Database Components
|
||||
C:\Program Files\Borland\Delphi6\Bin\dclact60.bpl=Borland ActionBar Components
|
||||
F:\Delphi\Components\madCollection\madBasic\Delphi 6\madBasic_.bpl=madBasic 1.1f · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madDisAsm\Delphi 6\madDisAsm_.bpl=madDisAsm 2.0a · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExcept_.bpl=madExcept 2.6a · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptWizard_.bpl=madExceptWizard 2.6 · www.madshi.net
|
||||
c:\program files\borland\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component
|
||||
C:\Program Files\Borland\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\ThemeManager6.bpl=Windows XP Theme Manager
|
||||
H:\Downloads\commentexpert.bpl=Comment Expert v1.0 Alpha
|
||||
<<<<<<< .working
|
||||
=======
|
||||
F:\Delphi\Components\DevExpress\OrgChart Suite\Lib\dcldxDBOrD6.bpl=ExpressDBOrgChart by Developer Express Inc.
|
||||
>>>>>>> .merge-right.r40
|
||||
|
||||
@ -7,9 +7,11 @@ uses
|
||||
madLinkDisAsm,
|
||||
SysUtils,
|
||||
X2UtHashes,
|
||||
X2UtBinaryTree;
|
||||
X2UtBinaryTree,
|
||||
FBTree in 'Forms\FBTree.pas' {frmBTree};
|
||||
|
||||
|
||||
<<<<<<< .working
|
||||
procedure DebugBTree(const ANode: PX2UtBTreeNode; const AIndent: Integer = 0);
|
||||
begin
|
||||
WriteLn(StringOfChar(' ', AIndent), ANode^.Index);
|
||||
@ -25,6 +27,8 @@ end;
|
||||
type
|
||||
THackBTree = class(TX2UtCustomBTree);
|
||||
|
||||
=======
|
||||
>>>>>>> .merge-right.r40
|
||||
var
|
||||
shData: TX2UtStringHash;
|
||||
btTest: TX2UtStringBTree;
|
||||
@ -37,25 +41,32 @@ begin
|
||||
btTest := TX2UtStringBTree.Create();
|
||||
try
|
||||
Randomize();
|
||||
for iItem := 0 to 31 do
|
||||
for iItem := 0 to 61 do
|
||||
btTest[Random(500)] := 'bla';
|
||||
|
||||
<<<<<<< .working
|
||||
btTest[300] := 'bla';
|
||||
btTest.Delete(300);
|
||||
=======
|
||||
TfrmBTree.Execute(btTest);
|
||||
>>>>>>> .merge-right.r40
|
||||
|
||||
<<<<<<< .working
|
||||
// Heh, hacking my own class. This is just for debugging the tree,
|
||||
// there should never be any need to access the root node outside of the
|
||||
// class otherwise, so I made it protected.
|
||||
pItem := THackBTree(btTest).Root;
|
||||
DebugBTree(pItem);
|
||||
|
||||
=======
|
||||
>>>>>>> .merge-right.r40
|
||||
WriteLn;
|
||||
btTest.Reset();
|
||||
while btTest.Next() do
|
||||
WriteLn(btTest.CurrentIndex, ' - ', btTest.CurrentValue);
|
||||
finally
|
||||
FreeAndNil(btTest);
|
||||
ReadLn;
|
||||
//ReadLn;
|
||||
end;
|
||||
}
|
||||
|
||||
@ -64,12 +75,16 @@ begin
|
||||
shData['thisakslhalskdjfhaslkdfjhaslkfjh'] := 'is';
|
||||
shData['a'] := 'test';
|
||||
|
||||
TfrmBTree.Execute(shData);
|
||||
|
||||
{
|
||||
shData.Reset();
|
||||
while shData.Next() do
|
||||
WriteLn(shData.CurrentKey, ': ', shData.CurrentValue, ' (',
|
||||
shData[shData.CurrentKey], ')');
|
||||
}
|
||||
finally
|
||||
FreeAndNil(shData);
|
||||
ReadLn;
|
||||
//ReadLn;
|
||||
end;
|
||||
end.
|
||||
|
||||
@ -97,10 +97,8 @@ begin
|
||||
}
|
||||
|
||||
// Test for the definitions
|
||||
{
|
||||
Settings.Define('Test', 'Value', 5, [[0, 5], [10, 15]]);
|
||||
Settings.ReadInteger('Test', 'Value');
|
||||
}
|
||||
|
||||
TraverseSection(Settings, '', 1);
|
||||
WriteLn;
|
||||
|
||||
@ -9,6 +9,9 @@
|
||||
:: convenience reasons I will however ignore your ranting and call my
|
||||
:: classes "TX2UtBTree". ;)
|
||||
::
|
||||
:: This unit contains code based on GNU libavl:
|
||||
:: http://www.msu.edu/~pfaffben/avl/libavl.html/
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
@ -17,8 +20,7 @@ unit X2UtBinaryTree;
|
||||
|
||||
interface
|
||||
uses
|
||||
SysUtils,
|
||||
VirtualTrees;
|
||||
SysUtils;
|
||||
|
||||
type
|
||||
//:$ Raised when the cursor is invalid.
|
||||
@ -28,31 +30,48 @@ type
|
||||
{
|
||||
:$ Internal representation of a node.
|
||||
}
|
||||
PPX2UtBTreeNode = ^PX2UtBTreeNode;
|
||||
PX2UtBTreeNode = ^TX2UtBTreeNode;
|
||||
TX2UtBTreeNode = record
|
||||
Index: Cardinal;
|
||||
Parent: PX2UtBTreeNode;
|
||||
Left: PX2UtBTreeNode;
|
||||
Right: PX2UtBTreeNode;
|
||||
Children: array[0..1] of PX2UtBTreeNode;
|
||||
Balance: Integer;
|
||||
Data: record end;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Internal parent stack
|
||||
:$ Internal node stack
|
||||
}
|
||||
TX2UtBTreeStackItem = record
|
||||
Node: PX2UtBTreeNode;
|
||||
Direction: Integer;
|
||||
end;
|
||||
|
||||
TX2UtBTreeStack = class(TObject)
|
||||
private
|
||||
FItems: array of PX2UtBTreeNode;
|
||||
FItems: array of TX2UtBTreeStackItem;
|
||||
FCount: Integer;
|
||||
FPosition: Integer;
|
||||
|
||||
function GetCount(): Integer;
|
||||
function GetNode(Index: Integer): PX2UtBTreeNode;
|
||||
function GetDirection(Index: Integer): Integer;
|
||||
procedure SetDirection(Index: Integer; const Value: Integer);
|
||||
procedure SetNode(Index: Integer; const Value: PX2UtBTreeNode);
|
||||
public
|
||||
constructor Create();
|
||||
|
||||
procedure Clear();
|
||||
procedure Push(const ANode: PX2UtBTreeNode);
|
||||
function Pop(): PX2UtBTreeNode;
|
||||
procedure Push(const ANode: PX2UtBTreeNode; const ADirection: Integer = 0);
|
||||
function Pop(): PX2UtBTreeNode; overload;
|
||||
function Pop(var ADirection: Integer): PX2UtBTreeNode; overload;
|
||||
|
||||
procedure Reverse();
|
||||
property Node[Index: Integer]: PX2UtBTreeNode read GetNode
|
||||
write SetNode; default;
|
||||
property Direction[Index: Integer]: Integer read GetDirection
|
||||
write SetDirection;
|
||||
|
||||
property Count: Integer read GetCount;
|
||||
end;
|
||||
|
||||
{
|
||||
@ -63,10 +82,11 @@ type
|
||||
}
|
||||
TX2UtCustomBTree = class(TObject)
|
||||
private
|
||||
FCount: Integer;
|
||||
FRoot: PX2UtBTreeNode;
|
||||
FCursor: PX2UtBTreeNode;
|
||||
FIsReset: Boolean;
|
||||
FParent: TX2UtBTreeStack;
|
||||
FParents: TX2UtBTreeStack;
|
||||
|
||||
FNodeSize: Cardinal;
|
||||
FDataSize: Cardinal;
|
||||
@ -74,12 +94,31 @@ type
|
||||
function GetTotalSize(): Cardinal;
|
||||
protected
|
||||
function GetCurrentIndex(): Cardinal;
|
||||
|
||||
function GetNodeData(const ANode: PX2UtBTreeNode): Pointer; virtual;
|
||||
procedure CopyNodeData(const ASource, ADest: PX2UtBTreeNode);
|
||||
|
||||
procedure BalanceInsert(var ANode: PX2UtBTreeNode);
|
||||
|
||||
function LookupNode(const AIndex: Cardinal;
|
||||
const ACanCreate: Boolean = False;
|
||||
const ASetCursor: Boolean = False): PX2UtBTreeNode;
|
||||
|
||||
procedure RotateLeft(var ANode: PX2UtBTreeNode);
|
||||
procedure RotateRight(var ANode: PX2UtBTreeNode);
|
||||
|
||||
function DeleteLeftShrunk(var ANode: PX2UtBTreeNode): Integer;
|
||||
function DeleteRightShrunk(var ANode: PX2UtBTreeNode): Integer;
|
||||
function DeleteFindHighest(const ATarget: PX2UtBTreeNode;
|
||||
var ANode: PX2UtBTreeNode;
|
||||
out AResult: Integer): Boolean;
|
||||
function DeleteFindLowest(const ATarget: PX2UtBTreeNode;
|
||||
var ANode: PX2UtBTreeNode;
|
||||
out AResult: Integer): Boolean;
|
||||
|
||||
function InternalDeleteNode(var ARoot: PX2UtBTreeNode;
|
||||
const AIndex: Cardinal): Integer;
|
||||
procedure DeleteNode(const AIndex: Cardinal);
|
||||
|
||||
procedure InitNode(var ANode: PX2UtBTreeNode); virtual;
|
||||
procedure FreeNode(var ANode: PX2UtBTreeNode); virtual;
|
||||
|
||||
@ -89,7 +128,7 @@ type
|
||||
property Cursor: PX2UtBTreeNode read FCursor write FCursor;
|
||||
property Root: PX2UtBTreeNode read FRoot;
|
||||
property IsReset: Boolean read FIsReset write FIsReset;
|
||||
property Parent: TX2UtBTreeStack read FParent;
|
||||
property Parents: TX2UtBTreeStack read FParents;
|
||||
|
||||
property NodeSize: Cardinal read FNodeSize;
|
||||
property TotalSize: Cardinal read GetTotalSize;
|
||||
@ -128,6 +167,9 @@ type
|
||||
//:! The order in which nodes are traversed is from top to bottom, left
|
||||
//:! to right. Do not depend on the binary tree to sort the output.
|
||||
function Next(): Boolean; virtual;
|
||||
|
||||
//:$ Contains the number of nodes in the tree
|
||||
property Count: Integer read FCount;
|
||||
end;
|
||||
|
||||
{
|
||||
@ -203,6 +245,12 @@ resourcestring
|
||||
|
||||
const
|
||||
CStackSize = 32;
|
||||
CLeft = 0;
|
||||
CRight = 1;
|
||||
|
||||
CError = 0;
|
||||
COK = 1;
|
||||
CBalance = 2;
|
||||
|
||||
|
||||
{======================== TX2UtBTreeStack
|
||||
@ -234,39 +282,64 @@ begin
|
||||
SetLength(FItems, FCount);
|
||||
end;
|
||||
|
||||
FItems[FPosition] := ANode;
|
||||
with FItems[FPosition] do
|
||||
begin
|
||||
Node := ANode;
|
||||
Direction := ADirection;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2UtBTreeStack.Pop;
|
||||
function TX2UtBTreeStack.Pop(): PX2UtBTreeNode;
|
||||
begin
|
||||
Result := nil;
|
||||
if FPosition > -1 then
|
||||
if FPosition >= 0 then
|
||||
begin
|
||||
Result := FItems[FPosition];
|
||||
Result := FItems[FPosition].Node;
|
||||
Dec(FPosition);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtBTreeStack.Reverse;
|
||||
var
|
||||
iCount: Integer;
|
||||
iIndex: Integer;
|
||||
pSwap: PX2UtBTreeNode;
|
||||
|
||||
function TX2UtBTreeStack.Pop(var ADirection: Integer): PX2UtBTreeNode;
|
||||
begin
|
||||
if FPosition = -1 then
|
||||
exit;
|
||||
|
||||
iCount := (FPosition + 1) div 2;
|
||||
for iIndex := 0 to iCount - 1 do
|
||||
Result := nil;
|
||||
if FPosition >= 0 then
|
||||
begin
|
||||
pSwap := FItems[iIndex];
|
||||
FItems[iIndex] := FItems[FPosition - iIndex];
|
||||
FItems[FPosition - iIndex] := pSwap;
|
||||
ADirection := FItems[FPosition].Direction;
|
||||
Result := FItems[FPosition].Node;
|
||||
Dec(FPosition);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2UtBTreeStack.GetNode;
|
||||
begin
|
||||
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
||||
Result := FItems[Index].Node;
|
||||
end;
|
||||
|
||||
procedure TX2UtBTreeStack.SetNode;
|
||||
begin
|
||||
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
||||
FItems[Index].Node := Value;
|
||||
end;
|
||||
|
||||
function TX2UtBTreeStack.GetDirection;
|
||||
begin
|
||||
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
||||
Result := FItems[Index].Direction;
|
||||
end;
|
||||
|
||||
procedure TX2UtBTreeStack.SetDirection;
|
||||
begin
|
||||
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
||||
FItems[Index].Direction := Value;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtBTreeStack.GetCount;
|
||||
begin
|
||||
Result := FPosition + 1;
|
||||
end;
|
||||
|
||||
|
||||
{======================= TX2UtCustomBTree
|
||||
Initialization
|
||||
@ -275,16 +348,14 @@ constructor TX2UtCustomBTree.Create;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FParent := TX2UtBTreeStack.Create();
|
||||
FParents := TX2UtBTreeStack.Create();
|
||||
FNodeSize := SizeOf(TX2UtBTreeNode);
|
||||
end;
|
||||
|
||||
destructor TX2UtCustomBTree.Destroy;
|
||||
begin
|
||||
FreeAndNil(FParent);
|
||||
|
||||
if Assigned(FRoot) then
|
||||
FreeNode(FRoot);
|
||||
FreeAndNil(FParents);
|
||||
Clear();
|
||||
|
||||
inherited;
|
||||
end;
|
||||
@ -299,87 +370,463 @@ begin
|
||||
Result := Pointer(Cardinal(ANode) + NodeSize);
|
||||
end;
|
||||
|
||||
function TX2UtCustomBTree.LookupNode;
|
||||
procedure TX2UtCustomBTree.CopyNodeData;
|
||||
begin
|
||||
ADest^.Index := ASource^.Index;
|
||||
Move(GetNodeData(ASource)^,
|
||||
GetNodeData(ADest)^,
|
||||
DataSize);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtCustomBTree.BalanceInsert;
|
||||
var
|
||||
pNode: PX2UtBTreeNode;
|
||||
pSwap: PX2UtBTreeNode;
|
||||
|
||||
begin
|
||||
if ANode^.Balance = -2 then
|
||||
begin
|
||||
// Left-heavy
|
||||
pNode := ANode^.Children[CLeft];
|
||||
|
||||
if pNode^.Balance = -1 then
|
||||
begin
|
||||
pSwap := pNode;
|
||||
ANode^.Children[CLeft] := pNode^.Children[CRight];
|
||||
pNode^.Children[CRight] := ANode;
|
||||
pNode^.Balance := 0;
|
||||
ANode^.Balance := 0;
|
||||
end else
|
||||
begin
|
||||
Assert(pNode^.Balance = 1, '* BUG * Unexpected node balance');
|
||||
pSwap := pNode^.Children[CRight];
|
||||
pNode^.Children[CRight] := pSwap^.Children[CLeft];
|
||||
pSwap^.Children[CLeft] := pNode;
|
||||
ANode^.Children[CLeft] := pSwap^.Children[CRight];
|
||||
pSwap^.Children[CRight] := ANode;
|
||||
|
||||
case pSwap^.Balance of
|
||||
-1:
|
||||
begin
|
||||
pNode^.Balance := 0;
|
||||
ANode^.Balance := 1;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
pNode^.Balance := 0;
|
||||
ANode^.Balance := 0;
|
||||
end;
|
||||
else
|
||||
pNode^.Balance := -1;
|
||||
ANode^.Balance := 0;
|
||||
end;
|
||||
|
||||
pSwap^.Balance := 0;
|
||||
end;
|
||||
|
||||
ANode := pSwap;
|
||||
end else if ANode^.Balance = 2 then
|
||||
begin
|
||||
// Right-heavy
|
||||
pNode := ANode^.Children[CRight];
|
||||
|
||||
if pNode^.Balance = 1 then
|
||||
begin
|
||||
pSwap := pNode;
|
||||
ANode^.Children[CRight] := pNode^.Children[CLeft];
|
||||
pNode^.Children[CLeft] := ANode;
|
||||
pNode^.Balance := 0;
|
||||
ANode^.Balance := 0;
|
||||
end else
|
||||
begin
|
||||
Assert(pNode^.Balance = -1, '* BUG * Unexpected node balance');
|
||||
pSwap := pNode^.Children[CLeft];
|
||||
pNode^.Children[CLeft] := pSwap^.Children[CRight];
|
||||
pSwap^.Children[CRight] := pNode;
|
||||
ANode^.Children[CRight] := pSwap^.Children[CLeft];
|
||||
pSwap^.Children[CLeft] := ANode;
|
||||
|
||||
case pSwap^.Balance of
|
||||
1:
|
||||
begin
|
||||
pNode^.Balance := 0;
|
||||
ANode^.Balance := -1;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
pNode^.Balance := 0;
|
||||
ANode^.Balance := 0;
|
||||
end;
|
||||
else
|
||||
pNode^.Balance := 1;
|
||||
ANode^.Balance := 0;
|
||||
end;
|
||||
|
||||
pSwap^.Balance := 0;
|
||||
end;
|
||||
|
||||
ANode := pSwap;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtCustomBTree.LookupNode;
|
||||
var
|
||||
pCurrent: PPX2UtBTreeNode;
|
||||
pBalance: PPX2UtBTreeNode;
|
||||
pLast: PX2UtBTreeNode;
|
||||
pNode: PX2UtBTreeNode;
|
||||
pPath: TX2UtBTreeStack;
|
||||
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
if not Assigned(FRoot) then
|
||||
begin
|
||||
if ACanCreate then
|
||||
begin
|
||||
InitNode(FRoot);
|
||||
FRoot^.Index := AIndex;
|
||||
Result := FRoot;
|
||||
|
||||
if ASetCursor then
|
||||
Parents.Clear();
|
||||
|
||||
pPath := TX2UtBTreeStack.Create();
|
||||
try
|
||||
pCurrent := @FRoot;
|
||||
pBalance := nil;
|
||||
|
||||
repeat
|
||||
if Assigned(pCurrent^) then
|
||||
begin
|
||||
Parent.Clear();
|
||||
Cursor := FRoot;
|
||||
pPath.Push(pCurrent^);
|
||||
if pCurrent^^.Balance <> 0 then
|
||||
pBalance := pCurrent;
|
||||
|
||||
if AIndex > pCurrent^^.Index then
|
||||
// Continue on the right side
|
||||
pCurrent := @pCurrent^^.Children[CRight]
|
||||
else if AIndex < pCurrent^^.Index then
|
||||
// Continue on the left side
|
||||
pCurrent := @pCurrent^^.Children[CLeft]
|
||||
else
|
||||
begin
|
||||
// Found it!
|
||||
Result := pCurrent^;
|
||||
break;
|
||||
end;
|
||||
end else if ACanCreate then
|
||||
begin
|
||||
// Create new node
|
||||
InitNode(pCurrent^);
|
||||
pCurrent^^.Index := AIndex;
|
||||
|
||||
// Update balance factors
|
||||
pLast := pCurrent^;
|
||||
pNode := pPath.Pop();
|
||||
|
||||
while Assigned(pNode) do
|
||||
begin
|
||||
if pNode^.Children[CLeft] = pLast then
|
||||
Dec(pNode^.Balance)
|
||||
else
|
||||
Inc(pNode^.Balance);
|
||||
|
||||
if Assigned(pBalance) and (pNode = pBalance^) then
|
||||
break;
|
||||
|
||||
pLast := pNode;
|
||||
pNode := pPath.Pop();
|
||||
end;
|
||||
|
||||
if Assigned(pBalance) then
|
||||
BalanceInsert(pBalance^);
|
||||
|
||||
break;
|
||||
end else
|
||||
break;
|
||||
until False;
|
||||
finally
|
||||
FreeAndNil(pPath);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtCustomBTree.RotateLeft;
|
||||
var
|
||||
pSwap: PX2UtBTreeNode;
|
||||
|
||||
begin
|
||||
pSwap := ANode;
|
||||
ANode := ANode^.Children[CRight];
|
||||
pSwap^.Children[CRight] := ANode^.Children[CLeft];
|
||||
ANode^.Children[CLeft] := pSwap;
|
||||
end;
|
||||
|
||||
procedure TX2UtCustomBTree.RotateRight;
|
||||
var
|
||||
pSwap: PX2UtBTreeNode;
|
||||
|
||||
begin
|
||||
pSwap := ANode;
|
||||
ANode := ANode^.Children[CLeft];
|
||||
pSwap^.Children[CLeft] := ANode^.Children[CRight];
|
||||
ANode^.Children[CRight] := pSwap;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtCustomBTree.DeleteLeftShrunk;
|
||||
begin
|
||||
case ANode^.Balance of
|
||||
-1:
|
||||
begin
|
||||
ANode^.Balance := 0;
|
||||
Result := CBalance;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
ANode^.Balance := 1;
|
||||
Result := COK;
|
||||
end;
|
||||
1:
|
||||
begin
|
||||
case ANode^.Children[CRight]^.Balance of
|
||||
1:
|
||||
begin
|
||||
if ANode^.Children[CRight]^.Balance = 0 then
|
||||
ANode^.Balance := 1
|
||||
else
|
||||
ANode^.Balance := 0;
|
||||
|
||||
RotateLeft(ANode);
|
||||
Result := CBalance;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
ANode^.Balance := 1;
|
||||
ANode^.Children[CRight]^.Balance := -1;
|
||||
RotateLeft(ANode);
|
||||
Result := COK;
|
||||
end;
|
||||
-1:
|
||||
begin
|
||||
case ANode^.Children[CRight]^.Children[CLeft]^.Balance of
|
||||
-1:
|
||||
begin
|
||||
ANode^.Balance := 0;
|
||||
ANode^.Children[CRight]^.Balance := 1;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
ANode^.Balance := 0;
|
||||
ANode^.Children[CRight]^.Balance := 0;
|
||||
end;
|
||||
1:
|
||||
begin
|
||||
ANode^.Balance := -1;
|
||||
ANode^.Children[CRight]^.Balance := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
ANode^.Children[CRight]^.Children[CLeft]^.Balance := 0;
|
||||
RotateRight(ANode^.Children[CRight]);
|
||||
RotateLeft(ANode);
|
||||
Result := CBalance;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2UtCustomBTree.DeleteRightShrunk;
|
||||
begin
|
||||
case ANode^.Balance of
|
||||
1:
|
||||
begin
|
||||
ANode^.Balance := 0;
|
||||
Result := CBalance;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
ANode^.Balance := -1;
|
||||
Result := COK;
|
||||
end;
|
||||
-1:
|
||||
begin
|
||||
case ANode^.Children[CLeft]^.Balance of
|
||||
-1:
|
||||
begin
|
||||
if ANode^.Children[CLeft]^.Balance = 0 then
|
||||
ANode^.Balance := 1
|
||||
else
|
||||
ANode^.Balance := 0;
|
||||
|
||||
RotateRight(ANode);
|
||||
Result := CBalance;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
ANode^.Balance := -1;
|
||||
ANode^.Children[CLeft]^.Balance := 1;
|
||||
RotateRight(ANode);
|
||||
Result := COK;
|
||||
end;
|
||||
1:
|
||||
begin
|
||||
case ANode^.Children[CLeft]^.Children[CRight]^.Balance of
|
||||
-1:
|
||||
begin
|
||||
ANode^.Balance := 1;
|
||||
ANode^.Children[CLeft]^.Balance := 0;
|
||||
end;
|
||||
0:
|
||||
begin
|
||||
ANode^.Balance := 0;
|
||||
ANode^.Children[CLeft]^.Balance := 0;
|
||||
end;
|
||||
1:
|
||||
begin
|
||||
ANode^.Balance := 1;
|
||||
ANode^.Children[CLeft]^.Balance := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
ANode^.Children[CLeft]^.Children[CRight]^.Balance := 0;
|
||||
RotateLeft(ANode^.Children[CLeft]);
|
||||
RotateRight(ANode);
|
||||
Result := CBalance;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2UtCustomBTree.DeleteFindHighest;
|
||||
var
|
||||
pSwap: PX2UtBTreeNode;
|
||||
|
||||
begin
|
||||
AResult := CBalance;
|
||||
Result := False;
|
||||
|
||||
if not Assigned(ANode) then
|
||||
exit;
|
||||
|
||||
if Assigned(ANode^.Children[CRight]) then
|
||||
begin
|
||||
if not DeleteFindHighest(ATarget, ANode^.Children[CRight], AResult) then
|
||||
begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
pNode := Root;
|
||||
while Assigned(pNode) do
|
||||
begin
|
||||
if AIndex = pNode^.Index then
|
||||
begin
|
||||
Result := pNode;
|
||||
break;
|
||||
end else if AIndex < pNode^.Index then
|
||||
begin
|
||||
if Assigned(pNode^.Left) then
|
||||
pNode := pNode^.Left
|
||||
else
|
||||
begin
|
||||
if ACanCreate then
|
||||
begin
|
||||
InitNode(pNode^.Left);
|
||||
Result := pNode^.Left;
|
||||
Result^.Index := AIndex;
|
||||
Result^.Parent := pNode;
|
||||
if AResult = CBalance then
|
||||
AResult := DeleteRightShrunk(ANode);
|
||||
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
break;
|
||||
end;
|
||||
end else
|
||||
pSwap := ANode;
|
||||
CopyNodeData(ANode, ATarget);
|
||||
|
||||
ANode := ANode^.Children[CLeft];
|
||||
FreeNode(pSwap);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TX2UtCustomBTree.DeleteFindLowest;
|
||||
var
|
||||
pSwap: PX2UtBTreeNode;
|
||||
|
||||
begin
|
||||
AResult := CBalance;
|
||||
Result := False;
|
||||
|
||||
if not Assigned(ANode) then
|
||||
exit;
|
||||
|
||||
if Assigned(ANode^.Children[CLeft]) then
|
||||
begin
|
||||
if Assigned(pNode^.Right) then
|
||||
pNode := pNode^.Right
|
||||
else
|
||||
if not DeleteFindLowest(ATarget, ANode^.Children[CLeft], AResult) then
|
||||
begin
|
||||
if ACanCreate then
|
||||
begin
|
||||
InitNode(pNode^.Right);
|
||||
Result := pNode^.Right;
|
||||
Result^.Index := AIndex;
|
||||
Result^.Parent := pNode;
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
if AResult = CBalance then
|
||||
AResult := DeleteLeftShrunk(ANode);
|
||||
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if ASetCursor and Assigned(Result) then
|
||||
pSwap := ANode;
|
||||
CopyNodeData(ANode, ATarget);
|
||||
|
||||
ANode := ANode^.Children[CRight];
|
||||
FreeNode(pSwap);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtCustomBTree.InternalDeleteNode;
|
||||
var
|
||||
iResult: Integer;
|
||||
|
||||
begin
|
||||
if AIndex < ARoot^.Index then
|
||||
begin
|
||||
// Trace parents
|
||||
Parent.Clear();
|
||||
pNode := Result^.Parent;
|
||||
while Assigned(pNode) do
|
||||
// Continue on the left side
|
||||
iResult := InternalDeleteNode(ARoot^.Children[CLeft], AIndex);
|
||||
if iResult = CBalance then
|
||||
begin
|
||||
Parent.Push(pNode);
|
||||
pNode := pNode^.Parent;
|
||||
Result := DeleteLeftShrunk(ARoot);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Parents are now in reverse order
|
||||
Parent.Reverse();
|
||||
Result := iResult;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if AIndex > ARoot^.Index then
|
||||
begin
|
||||
// Continue on the right side
|
||||
iResult := InternalDeleteNode(ARoot^.Children[CRight], AIndex);
|
||||
if iResult = CBalance then
|
||||
begin
|
||||
Result := DeleteRightShrunk(ARoot);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := iResult;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if Assigned(ARoot^.Children[CLeft]) then
|
||||
if DeleteFindHighest(ARoot, ARoot^.Children[CLeft], iResult) then
|
||||
begin
|
||||
if iResult = CBalance then
|
||||
iResult := DeleteLeftShrunk(ARoot);
|
||||
|
||||
Result := iResult;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if Assigned(ARoot^.Children[CRight]) then
|
||||
if DeleteFindLowest(ARoot, ARoot^.Children[CRight], iResult) then
|
||||
begin
|
||||
if iResult = CBalance then
|
||||
iResult := DeleteRightShrunk(ARoot);
|
||||
|
||||
Result := iResult;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FreeNode(ARoot);
|
||||
Result := CBalance;
|
||||
end;
|
||||
|
||||
procedure TX2UtCustomBTree.DeleteNode;
|
||||
begin
|
||||
if not Assigned(FRoot) then
|
||||
exit;
|
||||
|
||||
InternalDeleteNode(FRoot, AIndex);
|
||||
end;
|
||||
|
||||
|
||||
@ -388,45 +835,43 @@ begin
|
||||
Assert(DataSize > 0, RSInvalidDataSize);
|
||||
GetMem(ANode, TotalSize);
|
||||
FillChar(ANode^, TotalSize, #0);
|
||||
|
||||
Inc(FCount);
|
||||
ClearCursor();
|
||||
end;
|
||||
|
||||
procedure TX2UtCustomBTree.FreeNode;
|
||||
begin
|
||||
if Assigned(ANode^.Left) then
|
||||
FreeNode(ANode^.Left);
|
||||
|
||||
if Assigned(ANode^.Right) then
|
||||
FreeNode(ANode^.Right);
|
||||
|
||||
if Assigned(ANode^.Parent) then
|
||||
if ANode^.Parent^.Left = ANode then
|
||||
ANode^.Parent^.Left := nil
|
||||
else if ANode^.Parent^.Right = ANode then
|
||||
ANode^.Parent^.Right := nil
|
||||
else
|
||||
Assert(False, RSOrphanNode);
|
||||
|
||||
FreeMem(ANode, TotalSize);
|
||||
ClearCursor();
|
||||
|
||||
ANode := nil;
|
||||
|
||||
Dec(FCount);
|
||||
ClearCursor();
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtCustomBTree.Clear;
|
||||
procedure ClearNode(var ANode: PX2UtBTreeNode);
|
||||
begin
|
||||
if Assigned(ANode^.Children[CLeft]) then
|
||||
ClearNode(ANode^.Children[CLeft]);
|
||||
|
||||
if Assigned(ANode^.Children[CRight]) then
|
||||
ClearNode(ANode^.Children[CRight]);
|
||||
|
||||
FreeNode(ANode);
|
||||
end;
|
||||
|
||||
begin
|
||||
if Assigned(FRoot) then
|
||||
FreeNode(FRoot);
|
||||
ClearNode(FRoot);
|
||||
|
||||
FRoot := nil;
|
||||
end;
|
||||
|
||||
procedure TX2UtCustomBTree.Delete;
|
||||
var
|
||||
pItem: PX2UtBTreeNode;
|
||||
|
||||
begin
|
||||
pItem := LookupNode(AIndex);
|
||||
if Assigned(pItem) then
|
||||
FreeNode(pItem);
|
||||
DeleteNode(AIndex);
|
||||
end;
|
||||
|
||||
function TX2UtCustomBTree.Exists;
|
||||
@ -475,39 +920,40 @@ begin
|
||||
|
||||
if not IsReset then
|
||||
begin
|
||||
if Assigned(Cursor^.Left) then
|
||||
if Assigned(Cursor^.Children[CLeft]) then
|
||||
begin
|
||||
// Valid left path, follow it
|
||||
Parent.Push(Cursor);
|
||||
Cursor := Cursor^.Left;
|
||||
Parents.Push(Cursor);
|
||||
Cursor := Cursor^.Children[CLeft];
|
||||
Result := True;
|
||||
end else if Assigned(Cursor^.Right) then
|
||||
end else if Assigned(Cursor^.Children[CRight]) then
|
||||
begin
|
||||
// Valid right path, follow it
|
||||
Parent.Push(Cursor);
|
||||
Cursor := Cursor^.Right;
|
||||
Parents.Push(Cursor);
|
||||
Cursor := Cursor^.Children[CRight];
|
||||
Result := True;
|
||||
end else
|
||||
begin
|
||||
// Neither is valid, traverse back up the parent stack until
|
||||
// a node if found with a sibling
|
||||
pCurrent := Cursor;
|
||||
pParent := Parent.Pop();
|
||||
pParent := Parents.Pop();
|
||||
ClearCursor();
|
||||
|
||||
while Assigned(pParent) do
|
||||
begin
|
||||
if Assigned(pParent^.Right) and (pParent^.Right <> pCurrent) then
|
||||
if Assigned(pParent^.Children[CRight]) and
|
||||
(pParent^.Children[CRight] <> pCurrent) then
|
||||
begin
|
||||
// Parent has a sibling, follow it
|
||||
Parent.Push(pParent);
|
||||
Cursor := pParent^.Right;
|
||||
Parents.Push(pParent);
|
||||
Cursor := pParent^.Children[CRight];
|
||||
Result := True;
|
||||
break;
|
||||
end;
|
||||
|
||||
pCurrent := pParent;
|
||||
pParent := Parent.Pop();
|
||||
pParent := Parents.Pop();
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
|
||||
@ -177,8 +177,6 @@ var
|
||||
pValue: PChar;
|
||||
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
iA := $9e3779b9;
|
||||
iB := iA;
|
||||
iC := iA;
|
||||
@ -377,19 +375,10 @@ end;
|
||||
|
||||
|
||||
function TX2UtCustomHash.GetCurrentKey;
|
||||
var
|
||||
pKey: PString;
|
||||
|
||||
begin
|
||||
Result := '';
|
||||
if ValidCursor(True) then
|
||||
begin
|
||||
Result := HashCursor^.Key;
|
||||
{
|
||||
pKey := GetNodeInternal(Cursor);
|
||||
Result := pKey^;
|
||||
}
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -537,9 +526,6 @@ end;
|
||||
|
||||
|
||||
function TX2UtStringHash.GetCurrentValue;
|
||||
var
|
||||
pData: PString;
|
||||
|
||||
begin
|
||||
if ValidCursor() then
|
||||
Result := PString(GetItemData(HashCursor))^;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user