From b105c57f5bf9b60e38fa1c32e5b6f5b3e0289f65 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 20 Aug 2004 10:03:59 +0000 Subject: [PATCH] Merged: avltree branch --- Test/Forms/FBTree.dfm | 33 ++ Test/Forms/FBTree.pas | 129 +++++++ Test/X2UtHashesTest.cfg | 4 +- Test/X2UtHashesTest.dof | 23 +- Test/X2UtHashesTest.dpr | 23 +- Test/X2UtilsSettingsTest.dpr | 2 - X2UtBinaryTree.pas | 724 ++++++++++++++++++++++++++++------- X2UtHashes.pas | 14 - 8 files changed, 777 insertions(+), 175 deletions(-) create mode 100644 Test/Forms/FBTree.dfm create mode 100644 Test/Forms/FBTree.pas diff --git a/Test/Forms/FBTree.dfm b/Test/Forms/FBTree.dfm new file mode 100644 index 0000000..0f417ee --- /dev/null +++ b/Test/Forms/FBTree.dfm @@ -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 diff --git a/Test/Forms/FBTree.pas b/Test/Forms/FBTree.pas new file mode 100644 index 0000000..2be6f6e --- /dev/null +++ b/Test/Forms/FBTree.pas @@ -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, ''); + + if Assigned(ARoot^.Children[1]) then + pRight := CreateNode(pNode, ARoot^.Children[1]) + else if Assigned(ARoot^.Children[0]) then + CreateTextNode(pNode, ''); + + 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. diff --git a/Test/X2UtHashesTest.cfg b/Test/X2UtHashesTest.cfg index 18d2c3d..e2e42ce 100644 --- a/Test/X2UtHashesTest.cfg +++ b/Test/X2UtHashesTest.cfg @@ -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 diff --git a/Test/X2UtHashesTest.dof b/Test/X2UtHashesTest.dof index 8e1398c..d90d6cb 100644 --- a/Test/X2UtHashesTest.dof +++ b/Test/X2UtHashesTest.dof @@ -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 diff --git a/Test/X2UtHashesTest.dpr b/Test/X2UtHashesTest.dpr index 9021e3f..66082b6 100644 --- a/Test/X2UtHashesTest.dpr +++ b/Test/X2UtHashesTest.dpr @@ -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. diff --git a/Test/X2UtilsSettingsTest.dpr b/Test/X2UtilsSettingsTest.dpr index 9b45854..185b191 100644 --- a/Test/X2UtilsSettingsTest.dpr +++ b/Test/X2UtilsSettingsTest.dpr @@ -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; diff --git a/X2UtBinaryTree.pas b/X2UtBinaryTree.pas index 16a4ffe..57b0e34 100644 --- a/X2UtBinaryTree.pas +++ b/X2UtBinaryTree.pas @@ -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,9 +20,8 @@ unit X2UtBinaryTree; interface uses - SysUtils, - VirtualTrees; - + SysUtils; + type //:$ Raised when the cursor is invalid. //:: Call Reset on the binary tree to create a valid cursor. @@ -28,31 +30,48 @@ type { :$ Internal representation of a node. } - PX2UtBTreeNode = ^TX2UtBTreeNode; - TX2UtBTreeNode = record + 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 } - TX2UtBTreeStack = class(TObject) + 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 - Result := nil; - - if not Assigned(FRoot) then + if ANode^.Balance = -2 then begin - if ACanCreate then - begin - InitNode(FRoot); - FRoot^.Index := AIndex; - Result := FRoot; + // Left-heavy + pNode := ANode^.Children[CLeft]; - if ASetCursor then - begin - Parent.Clear(); - Cursor := FRoot; + 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 ASetCursor then + Parents.Clear(); + + pPath := TX2UtBTreeStack.Create(); + try + pCurrent := @FRoot; + pBalance := nil; + + repeat + if Assigned(pCurrent^) then + begin + 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; + + if AResult = CBalance then + AResult := DeleteRightShrunk(ANode); + + Result := True; exit; end; - pNode := Root; - while Assigned(pNode) do + 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 AIndex = pNode^.Index then + if not DeleteFindLowest(ATarget, ANode^.Children[CLeft], AResult) 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; - end; - - break; - end; - end else - begin - if Assigned(pNode^.Right) then - pNode := pNode^.Right - else - begin - if ACanCreate then - begin - InitNode(pNode^.Right); - Result := pNode^.Right; - Result^.Index := AIndex; - Result^.Parent := pNode; - end; - - break; - end; - end; - end; - - if ASetCursor and Assigned(Result) then - begin - // Trace parents - Parent.Clear(); - pNode := Result^.Parent; - while Assigned(pNode) do - begin - Parent.Push(pNode); - pNode := pNode^.Parent; + Result := False; + exit; end; - // Parents are now in reverse order - Parent.Reverse(); + if AResult = CBalance then + AResult := DeleteLeftShrunk(ANode); + + Result := True; + exit; end; + + 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 + // Continue on the left side + iResult := InternalDeleteNode(ARoot^.Children[CLeft], AIndex); + if iResult = CBalance then + begin + Result := DeleteLeftShrunk(ARoot); + exit; + end; + + 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 diff --git a/X2UtHashes.pas b/X2UtHashes.pas index 88c16e0..fce93d6 100644 --- a/X2UtHashes.pas +++ b/X2UtHashes.pas @@ -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))^;