1184 lines
29 KiB
ObjectPascal
1184 lines
29 KiB
ObjectPascal
{
|
|
:: X2UtBinaryTree contains an implementation of the binary tree algorithm,
|
|
:: along with various descendants which implement support for a range of value
|
|
:: types (such as pointers, integers and strings). This effectively makes it
|
|
:: an associative array based on an integer key. For a hash implementation
|
|
:: based on string keys use the X2UtHashes unit.
|
|
::
|
|
:: P.S. I realise that a "B-Tree" is different from a binary tree. For
|
|
:: 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$
|
|
}
|
|
unit X2UtBinaryTree;
|
|
|
|
interface
|
|
uses
|
|
SysUtils;
|
|
|
|
type
|
|
//:$ Raised when the cursor is invalid.
|
|
//:: Call Reset on the binary tree to create a valid cursor.
|
|
EX2BTreeInvalidCursor = class(Exception);
|
|
|
|
{
|
|
:$ Internal representation of a node.
|
|
}
|
|
PPX2BTreeNode = ^PX2BTreeNode;
|
|
PX2BTreeNode = ^TX2BTreeNode;
|
|
TX2BTreeNode = record
|
|
Index: Cardinal;
|
|
Children: array[0..1] of PX2BTreeNode;
|
|
Balance: Integer;
|
|
Data: record end;
|
|
end;
|
|
|
|
{
|
|
:$ Internal node stack
|
|
}
|
|
TX2BTreeStackItem = record
|
|
Node: PX2BTreeNode;
|
|
Direction: Integer;
|
|
end;
|
|
|
|
TX2BTreeStack = class(TObject)
|
|
private
|
|
FItems: array of TX2BTreeStackItem;
|
|
FCount: Integer;
|
|
FPosition: Integer;
|
|
|
|
function GetCount(): Integer;
|
|
function GetNode(Index: Integer): PX2BTreeNode;
|
|
function GetDirection(Index: Integer): Integer;
|
|
procedure SetDirection(Index: Integer; const Value: Integer);
|
|
procedure SetNode(Index: Integer; const Value: PX2BTreeNode);
|
|
public
|
|
constructor Create();
|
|
|
|
procedure Clear();
|
|
procedure Push(const ANode: PX2BTreeNode; const ADirection: Integer = 0);
|
|
function Pop(): PX2BTreeNode; overload;
|
|
function Pop(var ADirection: Integer): PX2BTreeNode; overload;
|
|
|
|
property Node[Index: Integer]: PX2BTreeNode read GetNode
|
|
write SetNode; default;
|
|
property Direction[Index: Integer]: Integer read GetDirection
|
|
write SetDirection;
|
|
|
|
property Count: Integer read GetCount;
|
|
end;
|
|
|
|
{
|
|
:$ Binary tree implementation
|
|
|
|
:: This class implements a binary tree without knowing anything about
|
|
:: the data it contains.
|
|
}
|
|
TX2CustomBTree = class(TObject)
|
|
private
|
|
FCount: Integer;
|
|
FRoot: PX2BTreeNode;
|
|
FCursor: PX2BTreeNode;
|
|
FIsReset: Boolean;
|
|
FParents: TX2BTreeStack;
|
|
|
|
FNodeSize: Cardinal;
|
|
FDataSize: Cardinal;
|
|
|
|
function GetTotalSize(): Cardinal;
|
|
protected
|
|
function GetCurrentIndex(): Cardinal;
|
|
function GetNodeData(const ANode: PX2BTreeNode): Pointer; virtual;
|
|
procedure CopyNodeData(const ASource, ADest: PX2BTreeNode);
|
|
|
|
procedure BalanceInsert(var ANode: PX2BTreeNode);
|
|
|
|
function LookupNode(const AIndex: Cardinal;
|
|
const ACanCreate: Boolean = False;
|
|
const ASetCursor: Boolean = False): PX2BTreeNode;
|
|
|
|
procedure RotateLeft(var ANode: PX2BTreeNode);
|
|
procedure RotateRight(var ANode: PX2BTreeNode);
|
|
|
|
function DeleteLeftShrunk(var ANode: PX2BTreeNode): Integer;
|
|
function DeleteRightShrunk(var ANode: PX2BTreeNode): Integer;
|
|
function DeleteFindHighest(const ATarget: PX2BTreeNode;
|
|
var ANode: PX2BTreeNode;
|
|
out AResult: Integer): Boolean;
|
|
function DeleteFindLowest(const ATarget: PX2BTreeNode;
|
|
var ANode: PX2BTreeNode;
|
|
out AResult: Integer): Boolean;
|
|
|
|
function InternalDeleteNode(var ARoot: PX2BTreeNode;
|
|
const AIndex: Cardinal): Integer;
|
|
procedure DeleteNode(const AIndex: Cardinal);
|
|
|
|
procedure InitNode(var ANode: PX2BTreeNode); virtual;
|
|
procedure FreeNode(var ANode: PX2BTreeNode); virtual;
|
|
|
|
procedure ClearCursor(); virtual;
|
|
function ValidCursor(const ARaiseError: Boolean = True): Boolean; virtual;
|
|
|
|
property Cursor: PX2BTreeNode read FCursor write FCursor;
|
|
property Root: PX2BTreeNode read FRoot;
|
|
property IsReset: Boolean read FIsReset write FIsReset;
|
|
property Parents: TX2BTreeStack read FParents;
|
|
|
|
property NodeSize: Cardinal read FNodeSize;
|
|
property TotalSize: Cardinal read GetTotalSize;
|
|
|
|
// Note: do NOT change DataSize after the first node has
|
|
// been created! This will result in an Access Violation!
|
|
property DataSize: Cardinal read FDataSize write FDataSize;
|
|
|
|
//:$ Returns the index at the current cursor location.
|
|
property CurrentIndex: Cardinal read GetCurrentIndex;
|
|
public
|
|
constructor Create(); virtual;
|
|
destructor Destroy(); override;
|
|
|
|
//:$ Clears the tree.
|
|
procedure Clear();
|
|
|
|
//:$ Deletes a node from the tree.
|
|
procedure Delete(const AIndex: Cardinal);
|
|
|
|
//:$ Checks if an index exists in the tree.
|
|
//:: If the ASetCursor parameter is set to True, the cursor will be
|
|
//:: positioned at the item if it is found.
|
|
function Exists(const AIndex: Cardinal; const ASetCursor: Boolean = False): Boolean;
|
|
|
|
//:$ Resets the node cursor.
|
|
//:: The node cursor can be used to traverse through the binary tree.
|
|
//:: Call Reset first, followed by Next to get the first item. You can
|
|
//:: continue to call Next until it returns false. The CurrentIndex and
|
|
//:: CurrentValue properties will only be valid within the traversal.
|
|
//:! Adding or removing items will result in a loss of the current cursor
|
|
//:! until the next Reset call.
|
|
procedure Reset(); virtual;
|
|
|
|
//:$ Moves the node cursor to the next node.
|
|
//:! 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;
|
|
|
|
{
|
|
:$ Binary tree implementation for pointer values
|
|
}
|
|
TX2BTree = class(TX2CustomBTree)
|
|
private
|
|
function GetItem(Index: Cardinal): Pointer;
|
|
procedure SetItem(Index: Cardinal; const Value: Pointer);
|
|
|
|
function GetCurrentValue(): Pointer;
|
|
public
|
|
constructor Create(); override;
|
|
property CurrentIndex;
|
|
|
|
//:$ Gets or sets an item.
|
|
property Items[Index: Cardinal]: Pointer read GetItem
|
|
write SetItem; default;
|
|
|
|
//:$ Returns the value at the current cursor location
|
|
property CurrentValue: Pointer read GetCurrentValue;
|
|
end;
|
|
|
|
{
|
|
:$ Binary tree implementation for integer values
|
|
}
|
|
TX2IntegerBTree = class(TX2BTree)
|
|
protected
|
|
function GetItem(Index: Cardinal): Integer;
|
|
procedure SetItem(Index: Cardinal; const Value: Integer);
|
|
|
|
function GetCurrentValue(): Integer;
|
|
public
|
|
//:$ Gets or sets an item.
|
|
property Items[Index: Cardinal]: Integer read GetItem
|
|
write SetItem; default;
|
|
|
|
//:$ Returns the value at the current cursor location
|
|
property CurrentValue: Integer read GetCurrentValue;
|
|
end;
|
|
|
|
{
|
|
:$ Binary tree implementation for string values
|
|
}
|
|
TX2StringBTree = class(TX2CustomBTree)
|
|
protected
|
|
function GetItem(Index: Cardinal): String;
|
|
procedure SetItem(Index: Cardinal; const Value: String);
|
|
|
|
function GetCurrentValue(): String;
|
|
protected
|
|
procedure InitNode(var ANode: PX2BTreeNode); override;
|
|
procedure FreeNode(var ANode: PX2BTreeNode); override;
|
|
public
|
|
constructor Create(); override;
|
|
property CurrentIndex;
|
|
|
|
//:$ Gets or sets an item.
|
|
property Items[Index: Cardinal]: String read GetItem
|
|
write SetItem; default;
|
|
|
|
//:$ Returns the value at the current cursor location
|
|
property CurrentValue: String read GetCurrentValue;
|
|
end;
|
|
|
|
{
|
|
:$ Binary tree implementation for object values
|
|
}
|
|
TX2ObjectBTree = class(TX2BTree)
|
|
private
|
|
FOwnsObjects: Boolean;
|
|
protected
|
|
function GetItem(Index: Cardinal): TObject;
|
|
procedure SetItem(Index: Cardinal; const Value: TObject);
|
|
|
|
function GetCurrentValue(): TObject;
|
|
protected
|
|
procedure FreeNode(var ANode: PX2BTreeNode); override;
|
|
public
|
|
constructor Create(); overload; override;
|
|
constructor Create(AOwnsObjects: Boolean); reintroduce; overload;
|
|
|
|
//:$ Gets or sets an item.
|
|
property Items[Index: Cardinal]: TObject read GetItem
|
|
write SetItem; default;
|
|
|
|
//:$ Returns the value at the current cursor location
|
|
property CurrentValue: TObject read GetCurrentValue;
|
|
|
|
//:$ Determines if objects are destroyed when they are removed
|
|
property OwnsObjects: Boolean read FOwnsObjects
|
|
write FOwnsObjects;
|
|
end;
|
|
|
|
resourcestring
|
|
RSInvalidCursor = 'Cursor is invalid!';
|
|
RSInvalidDataSize = 'Invalid data size!';
|
|
|
|
implementation
|
|
resourcestring
|
|
RSOrphanNode = 'BUG: Node does not seem to belong to it''s parent!';
|
|
RSTooManyPops = 'More Pops than Pushes!';
|
|
|
|
const
|
|
CStackSize = 32;
|
|
CLeft = 0;
|
|
CRight = 1;
|
|
|
|
CError = 0;
|
|
COK = 1;
|
|
CBalance = 2;
|
|
|
|
|
|
{========================== TX2BTreeStack
|
|
Item Management
|
|
========================================}
|
|
constructor TX2BTreeStack.Create;
|
|
begin
|
|
inherited;
|
|
|
|
FCount := CStackSize;
|
|
FPosition := -1;
|
|
SetLength(FItems, FCount);
|
|
end;
|
|
|
|
|
|
procedure TX2BTreeStack.Clear;
|
|
begin
|
|
FCount := CStackSize;
|
|
FPosition := -1;
|
|
SetLength(FItems, FCount);
|
|
end;
|
|
|
|
procedure TX2BTreeStack.Push;
|
|
begin
|
|
Inc(FPosition);
|
|
if FPosition >= FCount then
|
|
begin
|
|
Inc(FCount, FCount);
|
|
SetLength(FItems, FCount);
|
|
end;
|
|
|
|
with FItems[FPosition] do
|
|
begin
|
|
Node := ANode;
|
|
Direction := ADirection;
|
|
end;
|
|
end;
|
|
|
|
function TX2BTreeStack.Pop(): PX2BTreeNode;
|
|
begin
|
|
Result := nil;
|
|
if FPosition >= 0 then
|
|
begin
|
|
Result := FItems[FPosition].Node;
|
|
Dec(FPosition);
|
|
end;
|
|
end;
|
|
|
|
function TX2BTreeStack.Pop(var ADirection: Integer): PX2BTreeNode;
|
|
begin
|
|
Result := nil;
|
|
if FPosition >= 0 then
|
|
begin
|
|
ADirection := FItems[FPosition].Direction;
|
|
Result := FItems[FPosition].Node;
|
|
Dec(FPosition);
|
|
end;
|
|
end;
|
|
|
|
function TX2BTreeStack.GetNode;
|
|
begin
|
|
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
|
Result := FItems[Index].Node;
|
|
end;
|
|
|
|
procedure TX2BTreeStack.SetNode;
|
|
begin
|
|
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
|
FItems[Index].Node := Value;
|
|
end;
|
|
|
|
function TX2BTreeStack.GetDirection;
|
|
begin
|
|
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
|
Result := FItems[Index].Direction;
|
|
end;
|
|
|
|
procedure TX2BTreeStack.SetDirection;
|
|
begin
|
|
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
|
|
FItems[Index].Direction := Value;
|
|
end;
|
|
|
|
|
|
function TX2BTreeStack.GetCount;
|
|
begin
|
|
Result := FPosition + 1;
|
|
end;
|
|
|
|
|
|
{======================= TX2CustomBTree
|
|
Initialization
|
|
========================================}
|
|
constructor TX2CustomBTree.Create;
|
|
begin
|
|
inherited;
|
|
|
|
FParents := TX2BTreeStack.Create();
|
|
FNodeSize := SizeOf(TX2BTreeNode);
|
|
end;
|
|
|
|
destructor TX2CustomBTree.Destroy;
|
|
begin
|
|
FreeAndNil(FParents);
|
|
Clear();
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
{========================= TX2CustomBTree
|
|
Tree Management
|
|
========================================}
|
|
function TX2CustomBTree.GetNodeData;
|
|
begin
|
|
Assert(DataSize > 0, RSInvalidDataSize);
|
|
Result := Pointer(Cardinal(ANode) + NodeSize);
|
|
end;
|
|
|
|
procedure TX2CustomBTree.CopyNodeData;
|
|
begin
|
|
ADest^.Index := ASource^.Index;
|
|
Move(GetNodeData(ASource)^,
|
|
GetNodeData(ADest)^,
|
|
DataSize);
|
|
end;
|
|
|
|
|
|
procedure TX2CustomBTree.BalanceInsert;
|
|
var
|
|
pNode: PX2BTreeNode;
|
|
pSwap: PX2BTreeNode;
|
|
|
|
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 TX2CustomBTree.LookupNode;
|
|
var
|
|
pCurrent: PPX2BTreeNode;
|
|
pBalance: PPX2BTreeNode;
|
|
pLast: PX2BTreeNode;
|
|
pNode: PX2BTreeNode;
|
|
pPath: TX2BTreeStack;
|
|
|
|
begin
|
|
Result := nil;
|
|
|
|
if ASetCursor then
|
|
Parents.Clear();
|
|
|
|
pPath := TX2BTreeStack.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^);
|
|
|
|
Result := pCurrent^;
|
|
break;
|
|
end else
|
|
break;
|
|
until False;
|
|
finally
|
|
FreeAndNil(pPath);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2CustomBTree.RotateLeft;
|
|
var
|
|
pSwap: PX2BTreeNode;
|
|
|
|
begin
|
|
pSwap := ANode;
|
|
ANode := ANode^.Children[CRight];
|
|
pSwap^.Children[CRight] := ANode^.Children[CLeft];
|
|
ANode^.Children[CLeft] := pSwap;
|
|
end;
|
|
|
|
procedure TX2CustomBTree.RotateRight;
|
|
var
|
|
pSwap: PX2BTreeNode;
|
|
|
|
begin
|
|
pSwap := ANode;
|
|
ANode := ANode^.Children[CLeft];
|
|
pSwap^.Children[CLeft] := ANode^.Children[CRight];
|
|
ANode^.Children[CRight] := pSwap;
|
|
end;
|
|
|
|
|
|
function TX2CustomBTree.DeleteLeftShrunk;
|
|
begin
|
|
Result := CError;
|
|
|
|
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 TX2CustomBTree.DeleteRightShrunk;
|
|
begin
|
|
Result := CError;
|
|
|
|
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 TX2CustomBTree.DeleteFindHighest;
|
|
var
|
|
pSwap: PX2BTreeNode;
|
|
|
|
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;
|
|
|
|
pSwap := ANode;
|
|
CopyNodeData(ANode, ATarget);
|
|
|
|
ANode := ANode^.Children[CLeft];
|
|
FreeNode(pSwap);
|
|
Result := True;
|
|
end;
|
|
|
|
function TX2CustomBTree.DeleteFindLowest;
|
|
var
|
|
pSwap: PX2BTreeNode;
|
|
|
|
begin
|
|
AResult := CBalance;
|
|
Result := False;
|
|
|
|
if not Assigned(ANode) then
|
|
exit;
|
|
|
|
if Assigned(ANode^.Children[CLeft]) then
|
|
begin
|
|
if not DeleteFindLowest(ATarget, ANode^.Children[CLeft], AResult) then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
|
|
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 TX2CustomBTree.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 TX2CustomBTree.DeleteNode;
|
|
begin
|
|
if not Assigned(FRoot) then
|
|
exit;
|
|
|
|
InternalDeleteNode(FRoot, AIndex);
|
|
end;
|
|
|
|
|
|
procedure TX2CustomBTree.InitNode;
|
|
begin
|
|
Assert(DataSize > 0, RSInvalidDataSize);
|
|
GetMem(ANode, TotalSize);
|
|
FillChar(ANode^, TotalSize, #0);
|
|
|
|
Inc(FCount);
|
|
ClearCursor();
|
|
end;
|
|
|
|
procedure TX2CustomBTree.FreeNode;
|
|
begin
|
|
FreeMem(ANode, TotalSize);
|
|
ANode := nil;
|
|
|
|
Dec(FCount);
|
|
ClearCursor();
|
|
end;
|
|
|
|
|
|
procedure TX2CustomBTree.Clear;
|
|
procedure ClearNode(var ANode: PX2BTreeNode);
|
|
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
|
|
ClearNode(FRoot);
|
|
|
|
FRoot := nil;
|
|
end;
|
|
|
|
procedure TX2CustomBTree.Delete;
|
|
begin
|
|
DeleteNode(AIndex);
|
|
end;
|
|
|
|
function TX2CustomBTree.Exists;
|
|
begin
|
|
Result := Assigned(LookupNode(AIndex, False, True));
|
|
end;
|
|
|
|
|
|
|
|
{========================= TX2CustomBTree
|
|
Tree Traversing
|
|
========================================}
|
|
function TX2CustomBTree.ValidCursor;
|
|
begin
|
|
Result := (Assigned(Cursor) and (not IsReset));
|
|
|
|
if (not Result) and (ARaiseError) then
|
|
raise EX2BTreeInvalidCursor.Create(RSInvalidCursor);
|
|
end;
|
|
|
|
procedure TX2CustomBTree.ClearCursor;
|
|
begin
|
|
Cursor := nil;
|
|
end;
|
|
|
|
|
|
procedure TX2CustomBTree.Reset;
|
|
begin
|
|
Cursor := Root;
|
|
IsReset := True;
|
|
end;
|
|
|
|
function TX2CustomBTree.Next;
|
|
var
|
|
pParent: PX2BTreeNode;
|
|
pCurrent: PX2BTreeNode;
|
|
|
|
begin
|
|
Result := False;
|
|
|
|
if not Assigned(Cursor) then
|
|
begin
|
|
IsReset := False;
|
|
exit;
|
|
end;
|
|
|
|
if not IsReset then
|
|
begin
|
|
if Assigned(Cursor^.Children[CLeft]) then
|
|
begin
|
|
// Valid left path, follow it
|
|
Parents.Push(Cursor);
|
|
Cursor := Cursor^.Children[CLeft];
|
|
Result := True;
|
|
end else if Assigned(Cursor^.Children[CRight]) then
|
|
begin
|
|
// Valid right path, follow it
|
|
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 := Parents.Pop();
|
|
ClearCursor();
|
|
|
|
while Assigned(pParent) do
|
|
begin
|
|
if Assigned(pParent^.Children[CRight]) and
|
|
(pParent^.Children[CRight] <> pCurrent) then
|
|
begin
|
|
// Parent has a sibling, follow it
|
|
Parents.Push(pParent);
|
|
Cursor := pParent^.Children[CRight];
|
|
Result := True;
|
|
break;
|
|
end;
|
|
|
|
pCurrent := pParent;
|
|
pParent := Parents.Pop();
|
|
end;
|
|
end;
|
|
end else
|
|
begin
|
|
IsReset := False;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function TX2CustomBTree.GetCurrentIndex;
|
|
begin
|
|
Result := 0;
|
|
if ValidCursor(True) then
|
|
Result := Cursor^.Index;
|
|
end;
|
|
|
|
function TX2CustomBTree.GetTotalSize;
|
|
begin
|
|
Result := FNodeSize + FDataSize;
|
|
end;
|
|
|
|
|
|
{=============================== TX2BTree
|
|
Item Management
|
|
========================================}
|
|
constructor TX2BTree.Create;
|
|
begin
|
|
inherited;
|
|
|
|
DataSize := SizeOf(Pointer);
|
|
end;
|
|
|
|
function TX2BTree.GetItem;
|
|
var
|
|
pNode: PX2BTreeNode;
|
|
|
|
begin
|
|
Result := nil;
|
|
pNode := LookupNode(Index);
|
|
if Assigned(pNode) then
|
|
Result := PPointer(GetNodeData(pNode))^;
|
|
end;
|
|
|
|
procedure TX2BTree.SetItem;
|
|
var
|
|
pNode: PX2BTreeNode;
|
|
|
|
begin
|
|
pNode := LookupNode(Index, True);
|
|
if Assigned(pNode) then
|
|
PPointer(GetNodeData(pNode))^ := Value;
|
|
end;
|
|
|
|
function TX2BTree.GetCurrentValue;
|
|
begin
|
|
Result := nil;
|
|
if ValidCursor(True) then
|
|
Result := PPointer(GetNodeData(Cursor))^;
|
|
end;
|
|
|
|
|
|
{======================== TX2IntegerBTree
|
|
Item Management
|
|
========================================}
|
|
function TX2IntegerBTree.GetItem;
|
|
begin
|
|
Result := Integer(inherited GetItem(Index));
|
|
end;
|
|
|
|
procedure TX2IntegerBTree.SetItem;
|
|
begin
|
|
inherited SetItem(Index, Pointer(Value));
|
|
end;
|
|
|
|
function TX2IntegerBTree.GetCurrentValue;
|
|
begin
|
|
Result := Integer(inherited GetCurrentValue());
|
|
end;
|
|
|
|
|
|
{========================= TX2StringBTree
|
|
Item Management
|
|
========================================}
|
|
constructor TX2StringBTree.Create;
|
|
begin
|
|
inherited;
|
|
|
|
DataSize := SizeOf(PString);
|
|
end;
|
|
|
|
|
|
procedure TX2StringBTree.InitNode;
|
|
var
|
|
pData: PString;
|
|
|
|
begin
|
|
inherited;
|
|
|
|
pData := GetNodeData(ANode);
|
|
Initialize(pData^);
|
|
end;
|
|
|
|
procedure TX2StringBTree.FreeNode;
|
|
var
|
|
pData: PString;
|
|
|
|
begin
|
|
pData := GetNodeData(ANode);
|
|
Finalize(pData^);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
function TX2StringBTree.GetItem;
|
|
var
|
|
pNode: PX2BTreeNode;
|
|
|
|
begin
|
|
Result := '';
|
|
pNode := LookupNode(Index);
|
|
if Assigned(pNode) then
|
|
Result := PString(GetNodeData(pNode))^;
|
|
end;
|
|
|
|
procedure TX2StringBTree.SetItem;
|
|
var
|
|
pNode: PX2BTreeNode;
|
|
|
|
begin
|
|
pNode := LookupNode(Index, True);
|
|
if Assigned(pNode) then
|
|
PString(GetNodeData(pNode))^ := Value;
|
|
end;
|
|
|
|
function TX2StringBTree.GetCurrentValue;
|
|
begin
|
|
if ValidCursor(True) then
|
|
Result := PString(GetNodeData(Cursor))^;
|
|
end;
|
|
|
|
|
|
{========================= TX2ObjectBTree
|
|
Item Management
|
|
========================================}
|
|
constructor TX2ObjectBTree.Create();
|
|
begin
|
|
inherited;
|
|
|
|
FOwnsObjects := False;
|
|
end;
|
|
|
|
constructor TX2ObjectBTree.Create(AOwnsObjects: Boolean);
|
|
begin
|
|
inherited Create();
|
|
|
|
FOwnsObjects := AOwnsObjects;
|
|
end;
|
|
|
|
|
|
function TX2ObjectBTree.GetItem;
|
|
begin
|
|
Result := TObject(inherited GetItem(Index));
|
|
end;
|
|
|
|
procedure TX2ObjectBTree.SetItem;
|
|
begin
|
|
inherited SetItem(Index, Pointer(Value));
|
|
end;
|
|
|
|
function TX2ObjectBTree.GetCurrentValue;
|
|
begin
|
|
Result := TObject(inherited GetCurrentValue());
|
|
end;
|
|
|
|
procedure TX2ObjectBTree.FreeNode;
|
|
var
|
|
pObject: ^TObject;
|
|
|
|
begin
|
|
if FOwnsObjects then
|
|
begin
|
|
pObject := GetNodeData(ANode);
|
|
|
|
if Assigned(pObject) then
|
|
FreeAndNil(pObject^);
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
end.
|