From 940e81f12375825d4c71435d39f1fd807a3ce1db Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Sat, 14 Jan 2012 17:58:59 +0100 Subject: [PATCH] * Replaced fgl with heContnrs * Fixed behavior of the undo packet list (fixes #88) --- Client/CentrED.lpi | 21 +- Client/CentrED.lpr | 6 + Client/ULightManager.pas | 8 +- Client/UfrmMain.pas | 49 +- Server/cedserver.lpi | 4 +- Server/cedserver.lpr | 5 + UContnrExt.pas | 54 + UOLib/UMap.pas | 6 +- UOLib/UStatics.pas | 6 +- UOLib/UWorldItem.pas | 6 +- heContnrs.pas | 7370 ++++++++++++++++++++++++++++++++++++++ 11 files changed, 7492 insertions(+), 43 deletions(-) create mode 100644 UContnrExt.pas create mode 100644 heContnrs.pas diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi index 4187d12..b486d52 100644 --- a/Client/CentrED.lpi +++ b/Client/CentrED.lpi @@ -138,6 +138,11 @@ + + + + + @@ -163,7 +168,7 @@ - + @@ -434,6 +439,16 @@ + + + + + + + + + + @@ -462,7 +477,6 @@ - @@ -470,8 +484,7 @@ - + diff --git a/Client/CentrED.lpr b/Client/CentrED.lpr index d633c3d..1bb1597 100644 --- a/Client/CentrED.lpr +++ b/Client/CentrED.lpr @@ -28,6 +28,7 @@ program CentrED; {$mode objfpc}{$H+} uses + {$IFNDEF NoLogging}heaptrc,{$ENDIF} {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} @@ -43,7 +44,12 @@ begin end; begin + {$IFNDEF NoLogging} + SetHeapTraceOutput('CentrED.trc'); + {$ENDIF} + OnGetApplicationName := @GetApplicationName; + Application.Initialize; Application.CreateForm(TdmNetwork, dmNetwork); Application.Run; diff --git a/Client/ULightManager.pas b/Client/ULightManager.pas index 71789a3..dde8314 100644 --- a/Client/ULightManager.pas +++ b/Client/ULightManager.pas @@ -21,7 +21,7 @@ * CDDL HEADER END * * - * Portions Copyright 2011 Andreas Schneider + * Portions Copyright 2012 Andreas Schneider *) unit ULightManager; @@ -31,8 +31,8 @@ interface uses Classes, SysUtils, Imaging, ImagingTypes, ImagingClasses, ImagingCanvases, - ImagingOpenGL, GL, GLu, GLext, fgl, ULandscape, UWorldItem, UCacheManager, - Math; + ImagingOpenGL, GL, GLu, GLext, Math, heContnrs, ULandscape, UWorldItem, + UCacheManager; type @@ -70,7 +70,7 @@ type property Material: TLightMaterial read FMaterial; end; - TLightSources = specialize TFPGObjectList; + TLightSources = specialize TheObjectVector; { TLightManager } diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index b7f0ff0..f5b58f5 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -34,8 +34,9 @@ uses ComCtrls, OpenGLContext, GL, GLu, UGameResources, ULandscape, ExtCtrls, StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, - XMLPropStorage, fgl, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, - UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager; + XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, + UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, heContnrs, + UContnrExt; type TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object; @@ -43,12 +44,12 @@ type TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered); TScreenBufferStates = set of TScreenBufferState; - TBlockInfoList = specialize TFPGList; + TBlockInfoList = specialize TheVector; TGhostTile = class(TStaticItem); - TPacketList = specialize TFPGObjectList; - TAccessChangedListeners = specialize TFPGList; - TSelectionListeners = specialize TFPGList; + TPacketList = specialize TheObjectVector; + TAccessChangedListeners = specialize TPointerVectorSet; + TSelectionListeners = specialize TPointerVectorSet; TTileHintInfo = record Name: String; @@ -650,6 +651,7 @@ var tileX, tileY, newX, newY: Word; targetBlocks: TBlockInfoList; targetTile: TWorldItem; + selectionListener: TSelectionListener; begin Logger.EnterMethod([lcClient, lcDebug], 'MouseUp'); if Button <> mbLeft then @@ -677,8 +679,8 @@ begin mnuGrabTileIDClick(nil); end; - for i := FSelectionListeners.Count - 1 downto 0 do - FSelectionListeners[i](CurrentTile); + for selectionListener in FSelectionListeners.Reversed do + selectionListener(CurrentTile); end; if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then @@ -1123,14 +1125,16 @@ end; procedure TfrmMain.acUndoExecute(Sender: TObject); var - i: Integer; + packet: TPacket; begin - for i := FUndoList.Count - 1 downto 0 do - begin - dmNetwork.Send(FUndoList[i]); - FUndoList[i] := nil; - end; - FUndoList.Clear; + //Send each reversed action in reverse order. + for packet in FUndoList.Reversed do + dmNetwork.Send(packet); + + //Cleanup without freeing the objects (this was already done by dmNetwork.Send) + FUndoList.Wipe; + + //No Undo packets, nothing to undo. acUndo.Enabled := False; end; @@ -1912,25 +1916,23 @@ end; procedure TfrmMain.RegisterAccessChangedListener( AListener: TAccessChangedListener); begin - if FAccessChangedListeners.IndexOf(AListener) < 0 then - FAccessChangedListeners.Add(AListener); + FAccessChangedListeners.Include(AListener); end; procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener); begin - if FSelectionListeners.IndexOf(AListener) < 0 then - FSelectionListeners.Add(AListener); + FSelectionListeners.Include(AListener); end; procedure TfrmMain.UnregisterAccessChangedListener( AListener: TAccessChangedListener); begin - FAccessChangedListeners.Remove(AListener); + FAccessChangedListeners.Exclude(AListener); end; procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener); begin - FSelectionListeners.Remove(AListener); + FSelectionListeners.Exclude(AListener); end; procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem); @@ -3057,6 +3059,7 @@ var sender, msg: string; i: Integer; accessLevel: TAccessLevel; + accessChangedListener: TAccessChangedListener; begin case ABuffer.ReadByte of $01: //client connected @@ -3111,8 +3114,8 @@ begin end; end; - for i := FAccessChangedListeners.Count - 1 downto 0 do - FAccessChangedListeners[i](accessLevel); + for accessChangedListener in FAccessChangedListeners.Reversed do + accessChangedListener(accessLevel); end; end; end; diff --git a/Server/cedserver.lpi b/Server/cedserver.lpi index f3ffad3..0426239 100644 --- a/Server/cedserver.lpi +++ b/Server/cedserver.lpi @@ -237,15 +237,13 @@ - - + diff --git a/Server/cedserver.lpr b/Server/cedserver.lpr index be6bd76..3ac6b04 100644 --- a/Server/cedserver.lpr +++ b/Server/cedserver.lpr @@ -28,6 +28,7 @@ program cedserver; {$mode objfpc}{$H+} uses + {$IFNDEF NoLogging}heaptrc,{$ENDIF} {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} @@ -36,6 +37,10 @@ uses {$R *.res} begin + {$IFNDEF NoLogging} + SetHeapTraceOutput('cedserver.trc'); + {$ENDIF} + Writeln(''); Writeln('CentrED Server Version ', VersionInfo.GetProductVersionString); Writeln(VersionInfo.GetCopyright(True)); diff --git a/UContnrExt.pas b/UContnrExt.pas new file mode 100644 index 0000000..7035866 --- /dev/null +++ b/UContnrExt.pas @@ -0,0 +1,54 @@ +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2012 Andreas Schneider + *) +unit UContnrExt; + +{$mode objfpc}{$H+} + +interface + +uses + heContnrs; + +type + + { TPointerVectorSet } + + generic TPointerVectorSet = class(specialize TheCmpVectorSet) + public + function Compare(const A, B: T): Integer; override; + end; + +implementation + +{ TPointerVectorSet } + +function TPointerVectorSet.Compare(const A, B: T): Integer; +begin + Result := @A - @B; +end; + +end. + diff --git a/UOLib/UMap.pas b/UOLib/UMap.pas index a223cd6..2b1a8dc 100644 --- a/UOLib/UMap.pas +++ b/UOLib/UMap.pas @@ -21,7 +21,7 @@ * CDDL HEADER END * * - * Portions Copyright 2009 Andreas Schneider + * Portions Copyright 2012 Andreas Schneider *) unit UMap; @@ -30,7 +30,7 @@ unit UMap; interface uses - SysUtils, Classes, fgl, UWorldItem; + SysUtils, Classes, heContnrs, UWorldItem; const MapCellSize = 3; @@ -60,7 +60,7 @@ type procedure Write(AData: TStream); override; end; - TMapCellList = specialize TFPGObjectList; + TMapCellList = specialize TheObjectVector; { TMapBlock } diff --git a/UOLib/UStatics.pas b/UOLib/UStatics.pas index 08535ca..ef6b94a 100644 --- a/UOLib/UStatics.pas +++ b/UOLib/UStatics.pas @@ -21,7 +21,7 @@ * CDDL HEADER END * * - * Portions Copyright 2009 Andreas Schneider + * Portions Copyright 2012 Andreas Schneider *) unit UStatics; @@ -30,7 +30,7 @@ unit UStatics; interface uses - SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata; + SysUtils, Classes, heContnrs, UGenericIndex, UWorldItem, UTiledata; type { TStaticItem } @@ -56,7 +56,7 @@ type procedure Write(AData: TStream); override; end; - TStaticItemList = specialize TFPGObjectList; + TStaticItemList = specialize TheObjectVector; { TStaticBlock} diff --git a/UOLib/UWorldItem.pas b/UOLib/UWorldItem.pas index 829535c..b56c89c 100644 --- a/UOLib/UWorldItem.pas +++ b/UOLib/UWorldItem.pas @@ -21,7 +21,7 @@ * CDDL HEADER END * * - * Portions Copyright 2009 Andreas Schneider + * Portions Copyright 2012 Andreas Schneider *) unit UWorldItem; @@ -30,7 +30,7 @@ unit UWorldItem; interface uses - Classes, fgl, UMulBlock; + Classes, heContnrs, UMulBlock; type TWorldBlock = class; @@ -81,7 +81,7 @@ type property RawZ: ShortInt read FZ; end; - TWorldItemList = specialize TFPGObjectList; + TWorldItemList = specialize TheObjectVector; { TWorldBlock } diff --git a/heContnrs.pas b/heContnrs.pas new file mode 100644 index 0000000..6ebdce2 --- /dev/null +++ b/heContnrs.pas @@ -0,0 +1,7370 @@ +unit heContnrs; { http://code.google.com/p/fprb/wiki/heContnrs } + +{$mode objfpc}{$H+} + +//------------------------------------------------------------------------------ +// Copyright 2010, bflm. All rights reserved. +// Use of this source code is governed by a BSD-style +// license that can be found in the LICENSE file. +//------------------------------------------------------------------------------ +// The list container is a FPC port/modification of source code from +// the Google Go project: http://code.google.com/p/go +// +// Copyright 2009 The Go Authors. All rights reserved. +// Use of this source code is governed by a BSD-style +// license that can be found in the LICENSE-GO file. +//------------------------------------------------------------------------------ + +{$if (FPC_VERSION < 2) or ((FPC_VERSION = 2) and (FPC_RELEASE < 6))} +{$fatal 'Requires FPC >= 2.6.0'} +{$endif} + +interface + +uses + SysUtils; + +type + + EMapKeyNotFound = class(Exception); + + { TheEnumerator } + + generic TheEnumerator = object + public type + TGetCurrent = function(var Iterator: TIterator): TValue of object; + TMoveNext = function(var Iterator: TIterator): Boolean of object; + private + FGetCurrent: TGetCurrent; + FIterator: TIterator; + FMoveNext: TMoveNext; + function GetCurrent: TValue; + public + procedure Init(const InitialIterator: TIterator; const Mover: TMoveNext; const Getter: TGetCurrent); + function MoveNext: Boolean; + property Current: TValue read GetCurrent; + end; + + { TheEnumeratorProvider } + + generic TheEnumeratorProvider = object + public + FEnumerator: TProvidedEnumerator; + function GetEnumerator: TProvidedEnumerator; + end; + + { TheObjectVector } + + generic TheObjectVector = class { http://code.google.com/p/fprb/wiki/TheObjectVector } + public type + PItem = ^TItem; + TCompare = function(const A, B: TItem): Integer; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + FOwnObjects: Boolean; + function GetFirst: TItem; + function GetItems(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + procedure SetItems(const Index: Integer; const AValue: TItem); + procedure Sort(Left, Right: Integer; const Compare: TCompare); + protected + property Data: PItem read FData; + public + constructor Create(const AOwnObjects: Boolean = True); + destructor Destroy; override; + function Add(const Item: TItem): Integer; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetEnumerator: TEnumerator; + function Has(const Item: TItem): Boolean; + function IndexOf(const Item: TItem): Integer; + function Push(const Item: TItem): TItem; + function Remove(const Item: TItem): Integer; + function Reversed: TEnumeratorProvider; + function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Insert(const Index: Integer; const Item: TItem); + procedure Kill; + procedure Pack; + procedure Sort(const Compare: TCompare); + procedure Swap(const ItemAIndex, ItemBIndex: Integer); + procedure Wipe; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Items[const Index: Integer]: TItem read GetItems write SetItems; default; + property Last: TItem read GetLast; + property OwnObjects: Boolean read FOwnObjects write FOwnObjects; + end; + + { TheVector } + + generic TheVector = class { http://code.google.com/p/fprb/wiki/TheVector } + public type + PItem = ^TItem; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function GetFirst: TItem; + function GetItems(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + procedure SetItems(const Index: Integer; const AValue: TItem); + procedure Sort(Left, Right: Integer); + protected + property Data: PItem read FData; + public + destructor Destroy; override; + function Add(const Item: TItem): Integer; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetEnumerator: TEnumerator; + function Has(const Item: TItem): Boolean; + function IndexOf(const Item: TItem): Integer; + function Push(const Item: TItem): TItem; + function Remove(const Item: TItem): Integer; + function Reversed: TEnumeratorProvider; + function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Insert(const Index: Integer; const Item: TItem); + procedure Pack; + procedure Sort; + procedure Swap(const ItemAIndex, ItemBIndex: Integer); + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Items[const Index: Integer]: TItem read GetItems write SetItems; default; + property Last: TItem read GetLast; + end; + + { TheCmpVector } + + generic TheCmpVector = class { http://code.google.com/p/fprb/wiki/TheCmpVector } + public type + PItem = ^TItem; + TCompare = function(const A, B: TItem): Integer; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function GetFirst: TItem; + function GetItems(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + procedure SetItems(const Index: Integer; const AValue: TItem); + procedure Sort(Left, Right: Integer); + protected + property Data: PItem read FData; + public + destructor Destroy; override; + function Add(const Item: TItem): Integer; + function Compare(const A, B: TItem): Integer; virtual; // abstract; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetEnumerator: TEnumerator; + function Has(const Item: TItem): Boolean; + function IndexOf(const Item: TItem): Integer; + function Push(const Item: TItem): TItem; + function Remove(const Item: TItem): Integer; + function Reversed: TEnumeratorProvider; + function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Insert(const Index: Integer; const Item: TItem); + procedure Pack; + procedure Sort; + procedure Swap(const ItemAIndex, ItemBIndex: Integer); + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Items[const Index: Integer]: TItem read GetItems write SetItems; default; + property Last: TItem read GetLast; + end; + + { TheSortVector } + + generic TheSortVector = class { http://code.google.com/p/fprb/wiki/TheSortVector } + public type + PItem = ^TItem; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function GetFirst: TItem; + function GetItems(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + procedure Insert(const Index: Integer; const Item: TItem); + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + protected + property Data: PItem read FData; + public + destructor Destroy; override; + function Add(const Item: TItem): Integer; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetEnumerator: TEnumerator; + function Has(const Item: TItem): Boolean; + function IndexOf(const Item: TItem): Integer; + function Push(const Item: TItem): TItem; + function Remove(const Item: TItem): Integer; + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Pack; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Items[const Index: Integer]: TItem read GetItems; default; + property Last: TItem read GetLast; + end; + + { TheVectorSet } + + generic TheVectorSet = class { http://code.google.com/p/fprb/wiki/TheVectorSet } + public type + PItem = ^TItem; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetFirst: TItem; + function GetItem(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + function GetMembership(const Item: TItem): Boolean; + procedure Insert(const Index: Integer; const Item: TItem); + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + procedure SetMembership(const Item: TItem; const AValue: Boolean); + protected + property Data: PItem read FData; + public + destructor Destroy; override; + function Exclude(const Item: TItem): Boolean; // true => was in set + function GetEnumerator: TEnumerator; + function Include(const Item: TItem): Boolean; // true => was in set + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Pack; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default; + property Last: TItem read GetLast; + end; + + { TheVectorMap } + + generic TheVectorMap = class { http://code.google.com/p/fprb/wiki/TheVectorMap } + public type + PItem = ^TItem; + TItem = record + Key: TKey; + Value: TValue; + end; + TKeyEnumerator = specialize TheEnumerator; + TValueEnumerator = specialize TheEnumerator; + TKeyEnumeratorProvider = specialize TheEnumeratorProvider; + TValueEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function GetFirst: TItem; + function GetItem(const Index: Integer): TItem; + function GetKey(const Index: Integer): TKey; + function GetCurrentKey(var Index: Integer): TKey; + function GetLast: TItem; + function GetMap(const AKey: TKey): TValue; + function GetValue(const Index: Integer): TValue; + function GetCurrentValue(var Index: Integer): TValue; + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue); + procedure SetCapacity(AValue: Integer); + procedure SetMap(const AKey: TKey; const AValue: TValue); + protected + property Data: PItem read FData; + function MissingKeyValue(const AKey: TKey): TValue; virtual; + public + destructor Destroy; override; + function Extract(const Index: Integer): TItem; + function Find(const AKey: TKey; out Index: Integer): Boolean; + function Has(const AKey: TKey): Boolean; + function IndexOf(const AKey: TKey): Integer; + function Keys: TKeyEnumeratorProvider; + function KeysReversed: TKeyEnumeratorProvider; + function Remove(const AKey: TKey): Integer; + function Values: TValueEnumeratorProvider; + function ValuesReversed: TValueEnumeratorProvider; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Pack; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Item[const Index: Integer]: TItem read GetItem; + property Key[const Index: Integer]: TKey read GetKey; + property Last: TItem read GetLast; + property Map[const AKey: TKey]: TValue read GetMap write SetMap; default; + property Value[const Index: Integer]: TValue read GetValue; + end; + + { TheCmpVectorMap } + + generic TheCmpVectorMap = class { http://code.google.com/p/fprb/wiki/TheCmpVectorMap } + public type + PItem = ^TItem; + TItem = record + Key: TKey; + Value: TValue; + end; + TKeyEnumerator = specialize TheEnumerator; + TValueEnumerator = specialize TheEnumerator; + TKeyEnumeratorProvider = specialize TheEnumeratorProvider; + TValueEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function GetFirst: TItem; + function GetItem(const Index: Integer): TItem; + function GetKey(const Index: Integer): TKey; + function GetCurrentKey(var Index: Integer): TKey; + function GetLast: TItem; + function GetMap(const AKey: TKey): TValue; + function GetValue(const Index: Integer): TValue; + function GetCurrentValue(var Index: Integer): TValue; + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue); + procedure SetCapacity(AValue: Integer); + procedure SetMap(const AKey: TKey; const AValue: TValue); + protected + property Data: PItem read FData; + function MissingKeyValue(const AKey: TKey): TValue; virtual; + public + destructor Destroy; override; + function Compare(const A, B: TKey): Integer; virtual; // abstract; + function Extract(const Index: Integer): TItem; + function Find(const AKey: TKey; out Index: Integer): Boolean; + function Has(const AKey: TKey): Boolean; + function IndexOf(const AKey: TKey): Integer; + function Keys: TKeyEnumeratorProvider; + function KeysReversed: TKeyEnumeratorProvider; + function Remove(const AKey: TKey): Integer; + function Values: TValueEnumeratorProvider; + function ValuesReversed: TValueEnumeratorProvider; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Pack; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Item[const Index: Integer]: TItem read GetItem; + property Key[const Index: Integer]: TKey read GetKey; + property Last: TItem read GetLast; + property Map[const AKey: TKey]: TValue read GetMap write SetMap; default; + property Value[const Index: Integer]: TValue read GetValue; + end; + + { TheObjectVectorMap } + + generic TheObjectVectorMap = class { http://code.google.com/p/fprb/wiki/TheObjectVectorMap } + public type + PItem = ^TItem; + TItem = record + Key: TKey; + Value: TValue; + end; + TKeyEnumerator = specialize TheEnumerator; + TValueEnumerator = specialize TheEnumerator; + TKeyEnumeratorProvider = specialize TheEnumeratorProvider; + TValueEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + FOwnObjects: Boolean; + function GetFirst: TItem; + function GetItem(const Index: Integer): TItem; + function GetKey(const Index: Integer): TKey; + function GetCurrentKey(var Index: Integer): TKey; + function GetLast: TItem; + function GetMap(const AKey: TKey): TValue; + function GetValue(const Index: Integer): TValue; + function GetCurrentValue(var Index: Integer): TValue; + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue); + procedure SetCapacity(AValue: Integer); + procedure SetMap(const AKey: TKey; const AValue: TValue); + protected + property Data: PItem read FData; + function MissingKeyValue(const AKey: TKey): TValue; virtual; + public + constructor Create(const AOwnObjects: Boolean = True); + destructor Destroy; override; + function Compare(const A, B: TKey): Integer; virtual; // abstract; + function Extract(const Index: Integer): TItem; + function Find(const AKey: TKey; out Index: Integer): Boolean; + function Has(const AKey: TKey): Boolean; + function IndexOf(const AKey: TKey): Integer; + function Keys: TKeyEnumeratorProvider; + function KeysReversed: TKeyEnumeratorProvider; + function Remove(const AKey: TKey): Integer; + function Values: TValueEnumeratorProvider; + function ValuesReversed: TValueEnumeratorProvider; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Pack; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Item[const Index: Integer]: TItem read GetItem; + property Key[const Index: Integer]: TKey read GetKey; + property Last: TItem read GetLast; + property Map[const AKey: TKey]: TValue read GetMap write SetMap; default; + property OwnObjects: Boolean read FOwnObjects write FOwnObjects; + property Value[const Index: Integer]: TValue read GetValue; + end; + + { TheCmpVectorSet } + + generic TheCmpVectorSet = class { http://code.google.com/p/fprb/wiki/TheCmpVectorSet } + public type + PItem = ^TItem; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetFirst: TItem; + function GetItem(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + function GetMembership(const Item: TItem): Boolean; + procedure Insert(const Index: Integer; const Item: TItem); + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + procedure SetMembership(const Item: TItem; const AValue: Boolean); + protected + property Data: PItem read FData; + public + destructor Destroy; override; + function Compare(const A, B: TItem): Integer; virtual; // abstract; + function Exclude(const Item: TItem): Boolean; // true => was in set + function GetEnumerator: TEnumerator; + function Include(const Item: TItem): Boolean; // true => was in set + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Pack; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default; + property Last: TItem read GetLast; + end; + + { TheObjectVectorSet } + + generic TheObjectVectorSet = class { http://code.google.com/p/fprb/wiki/TheObjectVectorSet } + public type + PItem = ^TItem; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + FOwnObjects: Boolean; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetFirst: TItem; + function GetItem(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + function GetMembership(const Item: TItem): Boolean; + procedure Insert(const Index: Integer; const Item: TItem); + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + procedure SetMembership(const Item: TItem; const AValue: Boolean); + protected + property Data: PItem read FData; + public + constructor Create(const AOwnObjects: Boolean = True); + destructor Destroy; override; + function Compare(const A, B: TItem): Integer; virtual; // abstract; + function Exclude(const Item: TItem): Boolean; // true => was in set + function GetEnumerator: TEnumerator; + function Include(const Item: TItem): Boolean; // true => was in set + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Kill; + procedure Pack; + procedure Wipe; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default; + property Last: TItem read GetLast; + property OwnObjects: Boolean read FOwnObjects write FOwnObjects; + end; + + { TheCmpSortVector } + + generic TheCmpSortVector = class { http://code.google.com/p/fprb/wiki/TheCmpSortVector } + public type + PItem = ^TItem; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + function GetFirst: TItem; + function GetItems(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + procedure Insert(const Index: Integer; const Item: TItem); + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + protected + property Data: PItem read FData; + public + destructor Destroy; override; + function Add(const Item: TItem): Integer; + function Compare(const A, B: TItem): Integer; virtual; // abstract; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetEnumerator: TEnumerator; + function Has(const Item: TItem): Boolean; + function IndexOf(const Item: TItem): Integer; + function Push(const Item: TItem): TItem; + function Remove(const Item: TItem): Integer; + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Pack; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Items[const Index: Integer]: TItem read GetItems; default; + property Last: TItem read GetLast; + end; + + { TheObjectSortVector } + + generic TheObjectSortVector = class { http://code.google.com/p/fprb/wiki/TheObjectSortVector } + public type + PItem = ^TItem; + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCapacity: Integer; + FCount: Integer; + FData: PItem; + FOwnObjects: Boolean; + function GetFirst: TItem; + function GetItems(const Index: Integer): TItem; + function GetCurrent(var Index: Integer): TItem; + function GetLast: TItem; + procedure Insert(const Index: Integer; const Item: TItem); + function MoveNext(var Index: Integer): Boolean; + function MovePrev(var Index: Integer): Boolean; + procedure SetCapacity(AValue: Integer); + protected + property Data: PItem read FData; + public + constructor Create(const AOwnObjects: Boolean = True); + destructor Destroy; override; + function Add(const Item: TItem): Integer; + function Compare(const A, B: TItem): Integer; virtual; // abstract; + function Extract(const Index: Integer): TItem; + function Find(const Item: TItem; out Index: Integer): Boolean; + function GetEnumerator: TEnumerator; + function Has(const Item: TItem): Boolean; + function IndexOf(const Item: TItem): Integer; + function Push(const Item: TItem): TItem; + function Remove(const Item: TItem): Integer; + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Delete(const Index: Integer); + procedure Kill; + procedure Pack; + procedure Wipe; + property Capacity: Integer read FCapacity write SetCapacity; + property Count: Integer read FCount; + property First: TItem read GetFirst; + property Items[const Index: Integer]: TItem read GetItems; default; + property Last: TItem read GetLast; + property OwnObjects: Boolean read FOwnObjects write FOwnObjects; + end; + + { TheList } + + generic TheList = class { http://code.google.com/p/fprb/wiki/TheList } + public type + PNode = ^TNode; + TNode = object + private + FNext: PNode; + FPrev: PNode; + public + Item: TItem; + property Next: PNode read FNext; + property Prev: PNode read FPrev; + end; + private type + TIterator = record + List: TObject; + Node: PNode; + end; + public type + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private type + PNode_ = ^TNode_; + TNode_ = object + public + FNext: PNode_; + FPrev: PNode_; + FItem: TItem; + end; + private + FCount: Integer; + FFirst: PNode; + FLast: PNode; + function CurrentItem(var Iterator: TIterator): TItem; + function InsertAfter_(const After, Node: PNode): PNode; + function InsertBack(const Node: PNode): PNode; + function InsertBefore_(const Node, Before: PNode): PNode; + function InsertFront(const Node: PNode): PNode; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function NewIterator: TIterator; + function NewNode(const AItem: TItem): PNode; + public + destructor Destroy; override; + function Extract(const Node: PNode): PNode; + function GetEnumerator: TEnumerator; + function InsertAfter(const After: PNode; const AItem: TItem): PNode; + function InsertBefore(const AItem: TItem; const Before: PNode): PNode; + function MoveAfter(const After, Node: PNode): PNode; + function MoveBefore(const Node, Before: PNode): PNode; + function MoveToBack(const Node: PNode): PNode; + function MoveToFront(const Node: PNode): PNode; + function PushBack(const AItem: TItem): PNode; + function PushFront(const AItem: TItem): PNode; + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Remove(Node: PNode); + property Count: Integer read FCount; + property First: PNode read FFirst; + property Last: PNode read FLast; + end; + + { TheObjectList } + + generic TheObjectList = class { http://code.google.com/p/fprb/wiki/TheObjectList } + public type + PNode = ^TNode; + TNode = object + private + FNext: PNode; + FPrev: PNode; + public + Item: TItem; + property Next: PNode read FNext; + property Prev: PNode read FPrev; + end; + private type + TIterator = record + List: TObject; + Node: PNode; + end; + public type + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private type + PNode_ = ^TNode_; + TNode_ = object + public + FNext: PNode_; + FPrev: PNode_; + FItem: TItem; + end; + private + FCount: Integer; + FFirst: PNode; + FLast: PNode; + FOwnObjects: Boolean; + function CurrentItem(var Iterator: TIterator): TItem; + function InsertAfter_(const After, Node: PNode): PNode; + function InsertBack(const Node: PNode): PNode; + function InsertBefore_(const Node, Before: PNode): PNode; + function InsertFront(const Node: PNode): PNode; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function NewIterator: TIterator; + function NewNode(const AItem: TItem): PNode; + public + constructor Create(const AOwnObjects: Boolean = True); + destructor Destroy; override; + function Extract(const Node: PNode): PNode; + function GetEnumerator: TEnumerator; + function InsertAfter(const After: PNode; const AItem: TItem): PNode; + function InsertBefore(const AItem: TItem; const Before: PNode): PNode; + function MoveAfter(const After, Node: PNode): PNode; + function MoveBefore(const Node, Before: PNode): PNode; + function MoveToBack(const Node: PNode): PNode; + function MoveToFront(const Node: PNode): PNode; + function PushBack(const AItem: TItem): PNode; + function PushFront(const AItem: TItem): PNode; + function Reversed: TEnumeratorProvider; + procedure Clear; + procedure Remove(Node: PNode); + property Count: Integer read FCount; + property First: PNode read FFirst; + property Last: PNode read FLast; + property OwnObjects: Boolean read FOwnObjects write FOwnObjects; + end; + + { TheBTreeSet } + + generic TheBTreeSet = class { http://code.google.com/p/fprb/wiki/TheBTreeSet } + private type + PPage = ^TPage; + PData = ^TDataPage; + PIndex = ^TIndexPage; + TPage = packed record // object + Count: Integer; + IsIndex: LongBool; + end; + TIndexPage = packed record // object(TPage) + Hdr: TPage; // must be first + Index: array[0..1] of record + Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root + DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root + end; + end; + TDataPage = packed record // object(TPage) + Hdr: TPage; // must be first + Prev, Next: PData; + Data: array[0..1] of TItem // KData-1..2*KData items + end; + TIterator = record + Page: PData; + Index: Integer; + UseSentinel: Boolean; + Sentinel: TItem; + end; + public type + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCount: Integer; + FFirst: PPage; + FKData: Integer; + FKIndex: Integer; + FLast: PPage; + FRoot: PPage; + private + function ExtractData(const P: PPage; const Index: Integer): TItem; + function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean; + function GetFirst: TItem; + function GetLast: TItem; + function GetCurrent(var Iterator: TIterator): TItem; + function GetMembership(const Item: TItem): Boolean; + function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider; + function Insert(const P: PPage; const Index: Integer): PPage; + function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; + function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage; + function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean; + procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); + procedure Clear(const P: PPage); + procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ExtractIndex(const P: PPage; const Index: Integer); + procedure MoveLeft(const Left, P: PPage; const N: Integer = 1); + procedure MoveRight(const P, Right: PPage; const N: Integer = 1); + procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); + procedure SetMembership(const Item: TItem; const AValue: Boolean); + procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); + procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer); + procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + property Root: PPage Read FRoot; + public + constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32); + destructor Destroy; override; + function Exclude(const Item: TItem): Boolean; + function GetEnumerator: TEnumerator; + function Include(const Item: TItem): Boolean; + function Reversed: TEnumeratorProvider; + procedure Clear; + property Count: Integer Read FCount; + property First: TItem read GetFirst; + property KData: Integer Read FKData; + property KIndex: Integer Read FKIndex; + property Last: TItem read GetLast; + property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default; + property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange; + end; + + { TheCmpBTreeSet } + + generic TheCmpBTreeSet = class { http://code.google.com/p/fprb/wiki/TheCmpBTreeSet } + private type + PPage = ^TPage; + PData = ^TDataPage; + PIndex = ^TIndexPage; + TPage = packed record // object + Count: Integer; + IsIndex: LongBool; + end; + TIndexPage = packed record // object(TPage) + Hdr: TPage; // must be first + Index: array[0..1] of record + Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root + DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root + end; + end; + TDataPage = packed record // object(TPage) + Hdr: TPage; // must be first + Prev, Next: PData; + Data: array[0..1] of TItem // KData-1..2*KData items + end; + TIterator = record + Page: PData; + Index: Integer; + UseSentinel: Boolean; + Sentinel: TItem; + end; + public type + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCount: Integer; + FFirst: PPage; + FKData: Integer; + FKIndex: Integer; + FLast: PPage; + FRoot: PPage; + private + function ExtractData(const P: PPage; const Index: Integer): TItem; + function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean; + function GetFirst: TItem; + function GetLast: TItem; + function GetCurrent(var Iterator: TIterator): TItem; + function GetMembership(const Item: TItem): Boolean; + function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider; + function Insert(const P: PPage; const Index: Integer): PPage; + function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; + function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage; + function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean; + procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); + procedure Clear(const P: PPage); + procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ExtractIndex(const P: PPage; const Index: Integer); + procedure MoveLeft(const Left, P: PPage; const N: Integer = 1); + procedure MoveRight(const P, Right: PPage; const N: Integer = 1); + procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); + procedure SetMembership(const Item: TItem; const AValue: Boolean); + procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); + procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer); + procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + property Root: PPage Read FRoot; + public + constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32); + destructor Destroy; override; + function Compare(const A, B: TItem): Integer; virtual; // abstract + function Exclude(const Item: TItem): Boolean; + function GetEnumerator: TEnumerator; + function Include(const Item: TItem): Boolean; + function Reversed: TEnumeratorProvider; + procedure Clear; + property Count: Integer Read FCount; + property First: TItem read GetFirst; + property KData: Integer Read FKData; + property KIndex: Integer Read FKIndex; + property Last: TItem read GetLast; + property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default; + property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange; + end; + + { TheObjectBTreeSet } + + generic TheObjectBTreeSet = class { http://code.google.com/p/fprb/wiki/TheObjectBTreeSet } + private type + PPage = ^TPage; + PData = ^TDataPage; + PIndex = ^TIndexPage; + TPage = packed record // object + Count: Integer; + IsIndex: LongBool; + end; + TIndexPage = packed record // object(TPage) + Hdr: TPage; // must be first + Index: array[0..1] of record + Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root + DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root + end; + end; + TDataPage = packed record // object(TPage) + Hdr: TPage; // must be first + Prev, Next: PData; + Data: array[0..1] of TItem // KData-1..2*KData items + end; + TIterator = record + Page: PData; + Index: Integer; + UseSentinel: Boolean; + Sentinel: TItem; + end; + public type + TEnumerator = specialize TheEnumerator; + TEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCount: Integer; + FFirst: PPage; + FKData: Integer; + FKIndex: Integer; + FLast: PPage; + FOwnObjects: Boolean; + FRoot: PPage; + private + function ExtractData(const P: PPage; const Index: Integer): TItem; + function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean; + function GetFirst: TItem; + function GetLast: TItem; + function GetCurrent(var Iterator: TIterator): TItem; + function GetMembership(const Item: TItem): Boolean; + function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider; + function Insert(const P: PPage; const Index: Integer): PPage; + function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; + function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage; + function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean; + procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); + procedure Clear(const P: PPage); + procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ExtractIndex(const P: PPage; const Index: Integer); + procedure MoveLeft(const Left, P: PPage; const N: Integer = 1); + procedure MoveRight(const P, Right: PPage; const N: Integer = 1); + procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); + procedure SetMembership(const Item: TItem; const AValue: Boolean); + procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); + procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer); + procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + property Root: PPage Read FRoot; + public + constructor Create(const AOwnObjects: Boolean = True; const AKIndex: Integer = 64; const AKData: Integer = 32); + destructor Destroy; override; + function Compare(const A, B: TItem): Integer; virtual; // abstract + function Exclude(const Item: TItem): Boolean; + function GetEnumerator: TEnumerator; + function Include(const Item: TItem): Boolean; + function Reversed: TEnumeratorProvider; + procedure Clear; + property Count: Integer Read FCount; + property First: TItem read GetFirst; + property KData: Integer Read FKData; + property KIndex: Integer Read FKIndex; + property Last: TItem read GetLast; + property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default; + property OwnObjects: Boolean read FOwnObjects write FOwnObjects; + property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange; + end; + + { TheBTreeMap } + + generic TheBTreeMap = class { http://code.google.com/p/fprb/wiki/TheBTreeMap } + private type + PPage = ^TPage; + PData = ^TDataPage; + PIndex = ^TIndexPage; + TPage = packed record // object + Count: Integer; + IsIndex: LongBool; + end; + TIndexPage = packed record // object(TPage) + Hdr: TPage; // must be first + Index: array[0..1] of record + Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root + DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root + end; + end; + TItem = packed record + Key: TKey; + Value: TValue; + end; + TDataPage = packed record // object(TPage) + Hdr: TPage; // must be first + Prev, Next: PData; + Data: array[0..1] of TItem; // KData-1..2*KData items + end; + TIterator = record + Page: PData; + Index: Integer; + UseSentinel: Boolean; + Sentinel: TKey; + end; + public type + TKeyEnumerator = specialize TheEnumerator; + TValueEnumerator = specialize TheEnumerator; + TKeyEnumeratorProvider = specialize TheEnumeratorProvider; + TValueEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCount: Integer; + FFirst: PPage; + FKData: Integer; + FKIndex: Integer; + FLast: PPage; + FRoot: PPage; + private + function ExtractData(const P: PPage; const Index: Integer): TValue; + function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean; + function GetCurrent(var Iterator: TIterator): TValue; + function GetCurrentKey(var Iterator: TIterator): TKey; + function GetFirst: TValue; + function GetFirstKey: TKey; + function GetLast: TValue; + function GetLastKey: TKey; + function GetMap(const Key: TKey): TValue; + function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider; + function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider; + function Insert(const P: PPage; const Index: Integer): PPage; + function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; + function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage; + function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean; + procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); + procedure Clear(const P: PPage); + procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ExtractIndex(const P: PPage; const Index: Integer); + procedure MoveLeft(const Left, P: PPage; const N: Integer = 1); + procedure MoveRight(const P, Right: PPage; const N: Integer = 1); + procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); + procedure SetMap(const Key: TKey; const Value: TValue); + procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); + procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean); + procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer); + procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + property Root: PPage Read FRoot; + protected + function MissingKeyValue(const Key: TKey): TValue; virtual; + public + constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32); + destructor Destroy; override; + function Delete(const Key: TKey): Boolean; + function Extract(const Key: TKey; out Value: TValue): Boolean; + function Get(const Key: TKey; out Value: TValue): Boolean; + function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean; + function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean; + function Keys: TKeyEnumeratorProvider; + function KeysReversed: TKeyEnumeratorProvider; + function Values: TValueEnumeratorProvider; + function ValuesReversed: TValueEnumeratorProvider; + procedure Clear; + property Count: Integer Read FCount; + property First: TValue read GetFirst; + property FirstKey: TKey read GetFirstKey; + property KData: Integer Read FKData; + property KIndex: Integer Read FKIndex; + property Last: TValue read GetLast; + property LastKey: TKey read GetLastKey; + property Map[const Key: TKey]: TValue read GetMap write SetMap; default; + property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange; + property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys; + end; + + { TheCmpBTreeMap } + + generic TheCmpBTreeMap = class { http://code.google.com/p/fprb/wiki/TheCmpBTreeMap } + private type + PPage = ^TPage; + PData = ^TDataPage; + PIndex = ^TIndexPage; + TPage = packed record // object + Count: Integer; + IsIndex: LongBool; + end; + TIndexPage = packed record // object(TPage) + Hdr: TPage; // must be first + Index: array[0..1] of record + Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root + DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root + end; + end; + TItem = packed record + Key: TKey; + Value: TValue; + end; + TDataPage = packed record // object(TPage) + Hdr: TPage; // must be first + Prev, Next: PData; + Data: array[0..1] of TItem; // KData-1..2*KData items + end; + TIterator = record + Page: PData; + Index: Integer; + UseSentinel: Boolean; + Sentinel: TKey; + end; + public type + TKeyEnumerator = specialize TheEnumerator; + TValueEnumerator = specialize TheEnumerator; + TKeyEnumeratorProvider = specialize TheEnumeratorProvider; + TValueEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCount: Integer; + FFirst: PPage; + FKData: Integer; + FKIndex: Integer; + FLast: PPage; + FRoot: PPage; + private + function ExtractData(const P: PPage; const Index: Integer): TValue; + function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean; + function GetCurrent(var Iterator: TIterator): TValue; + function GetCurrentKey(var Iterator: TIterator): TKey; + function GetFirst: TValue; + function GetFirstKey: TKey; + function GetLast: TValue; + function GetLastKey: TKey; + function GetMap(const Key: TKey): TValue; + function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider; + function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider; + function Insert(const P: PPage; const Index: Integer): PPage; + function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; + function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage; + function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean; + procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); + procedure Clear(const P: PPage); + procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ExtractIndex(const P: PPage; const Index: Integer); + procedure MoveLeft(const Left, P: PPage; const N: Integer = 1); + procedure MoveRight(const P, Right: PPage; const N: Integer = 1); + procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); + procedure SetMap(const Key: TKey; const Value: TValue); + procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); + procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean); + procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer); + procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + property Root: PPage Read FRoot; + protected + function MissingKeyValue(const Key: TKey): TValue; virtual; + public + constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32); + destructor Destroy; override; + function Compare(const A, B: TKey): Integer; virtual; // abstract + function Delete(const Key: TKey): Boolean; + function Extract(const Key: TKey; out Value: TValue): Boolean; + function Get(const Key: TKey; out Value: TValue): Boolean; + function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean; + function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean; + function Keys: TKeyEnumeratorProvider; + function KeysReversed: TKeyEnumeratorProvider; + function Values: TValueEnumeratorProvider; + function ValuesReversed: TValueEnumeratorProvider; + procedure Clear; + property Count: Integer Read FCount; + property First: TValue read GetFirst; + property FirstKey: TKey read GetFirstKey; + property KData: Integer Read FKData; + property KIndex: Integer Read FKIndex; + property Last: TValue read GetLast; + property LastKey: TKey read GetLastKey; + property Map[const Key: TKey]: TValue read GetMap write SetMap; default; + property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange; + property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys; + end; + + { TheObjectBTreeMap } + + generic TheObjectBTreeMap = class { http://code.google.com/p/fprb/wiki/TheObjectBTreeMap } + private type + PPage = ^TPage; + PData = ^TDataPage; + PIndex = ^TIndexPage; + TPage = packed record // object + Count: Integer; + IsIndex: LongBool; + end; + TIndexPage = packed record // object(TPage) + Hdr: TPage; // must be first + Index: array[0..1] of record + Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root + DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root + end; + end; + TItem = packed record + Key: TKey; + Value: TValue; + end; + TDataPage = packed record // object(TPage) + Hdr: TPage; // must be first + Prev, Next: PData; + Data: array[0..1] of TItem; // KData-1..2*KData items + end; + TIterator = record + Page: PData; + Index: Integer; + UseSentinel: Boolean; + Sentinel: TKey; + end; + public type + TKeyEnumerator = specialize TheEnumerator; + TValueEnumerator = specialize TheEnumerator; + TKeyEnumeratorProvider = specialize TheEnumeratorProvider; + TValueEnumeratorProvider = specialize TheEnumeratorProvider; + private + FCount: Integer; + FFirst: PPage; + FKData: Integer; + FKIndex: Integer; + FLast: PPage; + FOwnObjects: Boolean; + FRoot: PPage; + private + function ExtractData(const P: PPage; const Index: Integer): TValue; + function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean; + function GetCurrent(var Iterator: TIterator): TValue; + function GetCurrentKey(var Iterator: TIterator): TKey; + function GetFirst: TValue; + function GetFirstKey: TKey; + function GetLast: TValue; + function GetLastKey: TKey; + function GetMap(const Key: TKey): TValue; + function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider; + function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider; + function Insert(const P: PPage; const Index: Integer): PPage; + function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; + function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage; + function MoveNext(var Iterator: TIterator): Boolean; + function MovePrev(var Iterator: TIterator): Boolean; + function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage; + function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean; + procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); + procedure Clear(const P: PPage); + procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); + procedure ExtractIndex(const P: PPage; const Index: Integer); + procedure MoveLeft(const Left, P: PPage; const N: Integer = 1); + procedure MoveRight(const P, Right: PPage; const N: Integer = 1); + procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); + procedure SetMap(const Key: TKey; const Value: TValue); + procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); + procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean); + procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer); + procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); + property Root: PPage Read FRoot; + protected + function MissingKeyValue(const Key: TKey): TValue; virtual; + public + constructor Create(const AOwnObjects: Boolean = True; const AKIndex: Integer = 64; const AKData: Integer = 32); + destructor Destroy; override; + function Compare(const A, B: TKey): Integer; virtual; // abstract + function Delete(const Key: TKey): Boolean; + function Extract(const Key: TKey; out Value: TValue): Boolean; + function Get(const Key: TKey; out Value: TValue): Boolean; + function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean; + function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean; + function Keys: TKeyEnumeratorProvider; + function KeysReversed: TKeyEnumeratorProvider; + function Values: TValueEnumeratorProvider; + function ValuesReversed: TValueEnumeratorProvider; + procedure Clear; + property Count: Integer Read FCount; + property First: TValue read GetFirst; + property FirstKey: TKey read GetFirstKey; + property KData: Integer Read FKData; + property KIndex: Integer Read FKIndex; + property Last: TValue read GetLast; + property LastKey: TKey read GetLastKey; + property Map[const Key: TKey]: TValue read GetMap write SetMap; default; + property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange; + property OwnObjects: Boolean read FOwnObjects write FOwnObjects; + property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys; + end; + +implementation + +uses + Math; + +{ TheEnumerator } + +function TheEnumerator.GetCurrent: TValue; +begin + Result := FGetCurrent(FIterator); +end; + +function TheEnumerator.MoveNext: Boolean; +begin + Result := FMoveNext(FIterator); +end; + +procedure TheEnumerator.Init(const InitialIterator: TIterator; const Mover: TMoveNext; const Getter: TGetCurrent); +begin + Assert(Assigned(Mover)); + Assert(Assigned(Getter)); + FIterator := InitialIterator; + FMoveNext := Mover; + FGetCurrent := Getter; +end; + +{ TheEnumeratorProvider } + +function TheEnumeratorProvider.GetEnumerator: TProvidedEnumerator; +begin + Result := FEnumerator; +end; + +{ TheObjectVector } + +function TheObjectVector.GetItems(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheObjectVector.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheObjectVector.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheObjectVector.GetLast: TItem; +begin + Assert(Count <> 0); + Result :=FData[Count - 1]; +end; + +function TheObjectVector.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheObjectVector.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheObjectVector.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheObjectVector.SetItems(const Index: Integer; const AValue: TItem); +begin + Assert((Index >= 0) and (Index < Count)); + FData[Index] := AValue; +end; + +procedure TheObjectVector.Sort(Left, Right: Integer; const Compare: TCompare); +var + L, R: Integer; + Pivot: TItem; +begin + repeat + L := Left; + R := Right; + Pivot := FData[(L + R) shr 1]; + repeat + while Compare(Pivot, FData[L]) > 0 do + L += 1; + while Compare(Pivot, FData[R]) < 0 do + R -= 1; + if L <= R then begin + Swap(L, R); + L += 1; + R -= 1; + end; + until L > R; + if Left < R then + Sort(Left, R, Compare); + Left := L; + until L >= Right; +end; + +constructor TheObjectVector.Create(const AOwnObjects: Boolean); +begin + inherited Create; + OwnObjects := AOwnObjects; +end; + +destructor TheObjectVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheObjectVector.Add(const Item: TItem): Integer; +begin + Result := Count; + Inc(FCount); + if Result >= Capacity then + Capacity := 2 * Count; + FData[Result] := Item; +end; + +function TheObjectVector.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheObjectVector.Find(const Item: TItem; out Index: Integer): Boolean; +begin + Index := IndexOf(Item); + Result := Index >= 0; +end; + +function TheObjectVector.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheObjectVector.Has(const Item: TItem): Boolean; +begin + Result := IndexOf(Item) >= 0; +end; + +function TheObjectVector.IndexOf(const Item: TItem): Integer; +begin + Assert(@Item = @Item); // hint off + for Result := 0 to Count - 1 do + if FData[Result] = Item then + Exit; + Result := -1; +end; + +function TheObjectVector.Push(const Item: TItem): TItem; +begin + Add(Item); + Result := Item; +end; + +function TheObjectVector.Remove(const Item: TItem): Integer; +begin + if Find(Item, Result) then + Delete(Result); +end; + +function TheObjectVector.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +function TheObjectVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem; +begin + Assert((ItemAIndex >= 0) and (ItemAIndex < Count)); + Result := FData[ItemAIndex]; + FData[ItemAIndex] := ItemB; +end; + +procedure TheObjectVector.Clear; +var I: Integer; +begin + if OwnObjects then + for I := 0 to Count - 1 do + FData[I].Free; + FCount := 0; + Capacity := 0; +end; + +procedure TheObjectVector.Delete(const Index: Integer); +begin + Extract(Index); +end; + +procedure TheObjectVector.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + FData[Index] := Item; +end; + +procedure TheObjectVector.Kill; +begin + OwnObjects := False; + Free; +end; + +procedure TheObjectVector.Pack; +begin + Capacity := Count; +end; + +procedure TheObjectVector.Sort(const Compare: TCompare); +begin + if Count > 1 then + Sort(0, Count - 1, Compare); +end; + +procedure TheObjectVector.Swap(const ItemAIndex, ItemBIndex: Integer); +var Item: TItem; +begin + Assert((ItemAIndex >= 0) and (ItemAIndex < Count)); + Assert((ItemBIndex >= 0) and (ItemBIndex < Count)); + Item := FData[ItemAIndex]; + FData[ItemAIndex] := FData[ItemBIndex]; + FData[ItemBIndex] := Item; +end; + +procedure TheObjectVector.Wipe; +begin + FCount := 0; +end; + +{ TheVector } + +procedure TheVector.Pack; +begin + Capacity := Count; +end; + +procedure TheVector.Sort; +begin + if Count > 1 then + Sort(0, Count - 1); +end; + +procedure TheVector.Swap(const ItemAIndex, ItemBIndex: Integer); +var Item: TItem; +begin + Assert((ItemAIndex >= 0) and (ItemAIndex < Count)); + Assert((ItemBIndex >= 0) and (ItemBIndex < Count)); + Item := FData[ItemAIndex]; + FData[ItemAIndex] := FData[ItemBIndex]; + FData[ItemBIndex] := Item; +end; + +function TheVector.GetItems(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheVector.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheVector.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheVector.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheVector.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheVector.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheVector.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheVector.SetItems(const Index: Integer; const AValue: TItem); +begin + Assert((Index >= 0) and (Index < Count)); + FData[Index] := AValue; +end; + +procedure TheVector.Sort(Left, Right: Integer); +var + L, R: Integer; + Pivot: TItem; +begin + Assert(@Pivot = @Pivot); // hint off + repeat + L := Left; + R := Right; + Pivot := FData[(L + R) div 2]; + repeat + while Pivot > FData[L] do + L += 1; + while Pivot < FData[R] do + R -= 1; + if L <= R then begin + Swap(L, R); + L += 1; + R -= 1; + end; + until L > R; + if Left < R then + Sort(Left, R); + Left := L; + until L >= Right; +end; + +destructor TheVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheVector.Add(const Item: TItem): Integer; +begin + Result := Count; + Inc(FCount); + if Result >= Capacity then + Capacity := 2 * Count; + Initialize(FData[Result]); + FData[Result] := Item; +end; + +function TheVector.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheVector.Find(const Item: TItem; out Index: Integer): Boolean; +begin + Index := IndexOf(Item); + Result := Index >= 0; +end; + +function TheVector.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheVector.Has(const Item: TItem): Boolean; +begin + Result := IndexOf(Item) >= 0; +end; + +function TheVector.IndexOf(const Item: TItem): Integer; +begin + Assert(@Item = @Item); // hint off + for Result := 0 to Count - 1 do + if FData[Result] = Item then + Exit; + Result := -1; +end; + +function TheVector.Push(const Item: TItem): TItem; +begin + Add(Item); + Result := Item; +end; + +function TheVector.Remove(const Item: TItem): Integer; +begin + if Find(Item, Result) then + Delete(Result); +end; + +function TheVector.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +function TheVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem; +begin + Assert((ItemAIndex >= 0) and (ItemAIndex < Count)); + Result := FData[ItemAIndex]; + FData[ItemAIndex] := ItemB; +end; + +procedure TheVector.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheVector.Delete(const Index: Integer); +begin + Extract(Index); +end; + +procedure TheVector.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index] := Item; +end; + +{ TheCmpVector } + +procedure TheCmpVector.Pack; +begin + Capacity := Count; +end; + +procedure TheCmpVector.Sort; +begin + if Count > 1 then + Sort(0, Count - 1); +end; + +procedure TheCmpVector.Swap(const ItemAIndex, ItemBIndex: Integer); +var Item: TItem; +begin + Assert((ItemAIndex >= 0) and (ItemAIndex < Count)); + Assert((ItemBIndex >= 0) and (ItemBIndex < Count)); + if ItemAIndex = ItemBIndex then + Exit; + Item := FData[ItemAIndex]; + FData[ItemAIndex] := FData[ItemBIndex]; + FData[ItemBIndex] := Item; +end; + +function TheCmpVector.GetItems(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheCmpVector.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheCmpVector.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheCmpVector.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheCmpVector.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheCmpVector.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheCmpVector.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheCmpVector.SetItems(const Index: Integer; const AValue: TItem); +begin + Assert((Index >= 0) and (Index < Count)); + FData[Index] := AValue; +end; + +procedure TheCmpVector.Sort(Left, Right: Integer); +var + L, R: Integer; + Pivot: TItem; +begin + repeat + L := Left; + R := Right; + Pivot := FData[(L + R) div 2]; + repeat + while Compare(Pivot, FData[L]) > 0 do + L += 1; + while Compare(Pivot, FData[R]) < 0 do + R -= 1; + if L <= R then begin + Swap(L, R); + L += 1; + R -= 1; + end; + until L > R; + if Left < R then + Sort(Left, R); + Left := L; + until L >= Right; +end; + +destructor TheCmpVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheCmpVector.Add(const Item: TItem): Integer; +begin + Result := Count; + Inc(FCount); + if Result >= Capacity then + Capacity := 2 * Count; + Initialize(FData[Result]); + FData[Result] := Item; +end; + +function TheCmpVector.Compare(const A, B: TItem): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheCmpVector.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheCmpVector.Find(const Item: TItem; out Index: Integer): Boolean; +begin + Index := IndexOf(Item); + Result := Index >= 0; +end; + +function TheCmpVector.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheCmpVector.Has(const Item: TItem): Boolean; +begin + Result := IndexOf(Item) >= 0; +end; + +function TheCmpVector.IndexOf(const Item: TItem): Integer; +begin + for Result := 0 to Count - 1 do + if Compare(FData[Result], Item) = 0 then + Exit; + Result := -1; +end; + +function TheCmpVector.Push(const Item: TItem): TItem; +begin + Add(Item); + Result := Item; +end; + +function TheCmpVector.Remove(const Item: TItem): Integer; +begin + if Find(Item, Result) then + Delete(Result); +end; + +function TheCmpVector.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +function TheCmpVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem; +begin + Assert((ItemAIndex >= 0) and (ItemAIndex < Count)); + Result := FData[ItemAIndex]; + FData[ItemAIndex] := ItemB; +end; + +procedure TheCmpVector.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheCmpVector.Delete(const Index: Integer); +begin + Extract(Index); +end; + +procedure TheCmpVector.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index] := Item; +end; + +{ TheSortVector } + +procedure TheSortVector.Pack; +begin + Capacity := Count; +end; + +function TheSortVector.GetItems(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheSortVector.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheSortVector.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheSortVector.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheSortVector.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheSortVector.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheSortVector.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +destructor TheSortVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheSortVector.Add(const Item: TItem): Integer; +begin + Find(Item, Result); + Insert(Result, Item); +end; + +function TheSortVector.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheSortVector.Find(const Item: TItem; out Index: Integer): Boolean; +var L, H: Integer; +begin + Assert(@Item = @Item); // hint off + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + if Item < FData[Index] then + H := Index - 1 + else if Item = FData[Index] then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheSortVector.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheSortVector.Has(const Item: TItem): Boolean; +begin + Result := IndexOf(Item) >= 0; +end; + +function TheSortVector.IndexOf(const Item: TItem): Integer; +begin + if not Find(Item, Result) then + Result := -1; +end; + +function TheSortVector.Push(const Item: TItem): TItem; +begin + Add(Item); + Result := Item; +end; + +function TheSortVector.Remove(const Item: TItem): Integer; +begin + if Find(Item, Result) then + Delete(Result) + else + Result := -1; +end; + +function TheSortVector.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +procedure TheSortVector.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheSortVector.Delete(const Index: Integer); +begin + Extract(Index); +end; + +procedure TheSortVector.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index] := Item; +end; + +{ TheCmpSortVector } + +procedure TheCmpSortVector.Pack; +begin + Capacity := Count; +end; + +function TheCmpSortVector.GetItems(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheCmpSortVector.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheCmpSortVector.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheCmpSortVector.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheCmpSortVector.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheCmpSortVector.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheCmpSortVector.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +destructor TheCmpSortVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheCmpSortVector.Add(const Item: TItem): Integer; +begin + Find(Item, Result); + Insert(Result, Item); +end; + +function TheCmpSortVector.Compare(const A, B: TItem): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheCmpSortVector.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheCmpSortVector.Find(const Item: TItem; out Index: Integer): Boolean; +var L, H, Cmp: Integer; +begin + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + Cmp := Compare(Item, FData[Index]); + if Cmp < 0 then + H := Index - 1 + else if Cmp = 0 then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheCmpSortVector.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheCmpSortVector.Has(const Item: TItem): Boolean; +begin + Result := IndexOf(Item) >= 0; +end; + +function TheCmpSortVector.IndexOf(const Item: TItem): Integer; +begin + if not Find(Item, Result) then + Result := -1; +end; + +function TheCmpSortVector.Push(const Item: TItem): TItem; +begin + Add(Item); + Result := Item; +end; + +function TheCmpSortVector.Remove(const Item: TItem): Integer; +begin + if Find(Item, Result) then + Delete(Result) + else + Result := -1; +end; + +function TheCmpSortVector.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +procedure TheCmpSortVector.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheCmpSortVector.Delete(const Index: Integer); +begin + Extract(Index); +end; + +procedure TheCmpSortVector.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index] := Item; +end; + +{ TheObjectSortVector } + +procedure TheObjectSortVector.Pack; +begin + Capacity := Count; +end; + +procedure TheObjectSortVector.Wipe; +begin + FCount := 0; +end; + +function TheObjectSortVector.GetItems(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheObjectSortVector.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheObjectSortVector.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheObjectSortVector.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheObjectSortVector.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheObjectSortVector.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheObjectSortVector.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +constructor TheObjectSortVector.Create(const AOwnObjects: Boolean); +begin + inherited Create; + OwnObjects := AOwnObjects; +end; + +destructor TheObjectSortVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheObjectSortVector.Add(const Item: TItem): Integer; +begin + Find(Item, Result); + Insert(Result, Item); +end; + +function TheObjectSortVector.Compare(const A, B: TItem): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheObjectSortVector.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheObjectSortVector.Find(const Item: TItem; out Index: Integer): Boolean; +var L, H, Cmp: Integer; +begin + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + Cmp := Compare(Item, FData[Index]); + if Cmp < 0 then + H := Index - 1 + else if Cmp = 0 then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheObjectSortVector.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheObjectSortVector.Has(const Item: TItem): Boolean; +begin + Result := IndexOf(Item) >= 0; +end; + +function TheObjectSortVector.IndexOf(const Item: TItem): Integer; +begin + if not Find(Item, Result) then + Result := -1; +end; + +function TheObjectSortVector.Push(const Item: TItem): TItem; +begin + Add(Item); + Result := Item; +end; + +function TheObjectSortVector.Remove(const Item: TItem): Integer; +begin + if Find(Item, Result) then + Delete(Result) + else + Result := -1; +end; + +function TheObjectSortVector.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +procedure TheObjectSortVector.Clear; +var I: Integer; +begin + if OwnObjects then + for I := 0 to Count - 1 do + FData[I].Free; + FCount := 0; + Capacity := 0; +end; + +procedure TheObjectSortVector.Delete(const Index: Integer); +begin + Extract(Index); +end; + +procedure TheObjectSortVector.Kill; +begin + OwnObjects := False; + Free; +end; + +procedure TheObjectSortVector.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + FData[Index] := Item; +end; + +{ TheVectorSet } + +function TheVectorSet.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheVectorSet.Find(const Item: TItem; out Index: Integer): Boolean; +var L, H: Integer; +begin + Assert(@Item = @Item); // hint off + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + if Item < FData[Index] then + H := Index - 1 + else if Item = FData[Index] then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheVectorSet.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheVectorSet.GetItem(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheVectorSet.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheVectorSet.GetMembership(const Item: TItem): Boolean; +var Index: Integer; +begin + Result := Find(Item, Index); +end; + +function TheVectorSet.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +procedure TheVectorSet.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index] := Item; +end; + +function TheVectorSet.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheVectorSet.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheVectorSet.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheVectorSet.SetMembership(const Item: TItem; const AValue: Boolean); +begin + if AValue then + Include(Item) + else + Exclude(Item); +end; + +destructor TheVectorSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheVectorSet.Exclude(const Item: TItem): Boolean; +var Index: Integer; +begin + Result := Find(Item, Index); + if Result then + Extract(Index); +end; + +function TheVectorSet.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheVectorSet.Include(const Item: TItem): Boolean; +var Index: Integer; +begin + if Find(Item, Index) then + Exit(True); + Insert(Index, Item); + Result := False; +end; + +function TheVectorSet.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +procedure TheVectorSet.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheVectorSet.Pack; +begin + Capacity := Count; +end; + +{ TheCmpVectorSet } + +function TheCmpVectorSet.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheCmpVectorSet.Find(const Item: TItem; out Index: Integer): Boolean; +var L, H, Cmp: Integer; +begin + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + Cmp := Compare(Item, FData[Index]); + if Cmp < 0 then + H := Index - 1 + else if Cmp = 0 then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheCmpVectorSet.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheCmpVectorSet.GetItem(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheCmpVectorSet.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheCmpVectorSet.GetMembership(const Item: TItem): Boolean; +var Index: Integer; +begin + Result := Find(Item, Index); +end; + +function TheCmpVectorSet.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +procedure TheCmpVectorSet.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index] := Item; +end; + +function TheCmpVectorSet.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheCmpVectorSet.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheCmpVectorSet.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheCmpVectorSet.SetMembership(const Item: TItem; const AValue: Boolean); +begin + if AValue then + Include(Item) + else + Exclude(Item); +end; + +destructor TheCmpVectorSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheCmpVectorSet.Compare(const A, B: TItem): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheCmpVectorSet.Exclude(const Item: TItem): Boolean; +var Index: Integer; +begin + Result := Find(Item, Index); + if Result then + Extract(Index); +end; + +function TheCmpVectorSet.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheCmpVectorSet.Include(const Item: TItem): Boolean; +var Index: Integer; +begin + if Find(Item, Index) then + Exit(True); + Insert(Index, Item); + Result := False; +end; + +function TheCmpVectorSet.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +procedure TheCmpVectorSet.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheCmpVectorSet.Pack; +begin + Capacity := Count; +end; + +{ TheObjectVectorSet } + +function TheObjectVectorSet.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheObjectVectorSet.Find(const Item: TItem; out Index: Integer): Boolean; +var L, H, Cmp: Integer; +begin + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + Cmp := Compare(Item, FData[Index]); + if Cmp < 0 then + H := Index - 1 + else if Cmp = 0 then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheObjectVectorSet.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheObjectVectorSet.GetItem(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheObjectVectorSet.GetCurrent(var Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheObjectVectorSet.GetMembership(const Item: TItem): Boolean; +var Index: Integer; +begin + Result := Find(Item, Index); +end; + +function TheObjectVectorSet.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +procedure TheObjectVectorSet.Insert(const Index: Integer; const Item: TItem); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index] := Item; +end; + +function TheObjectVectorSet.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheObjectVectorSet.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheObjectVectorSet.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheObjectVectorSet.SetMembership(const Item: TItem; const AValue: Boolean); +begin + if AValue then + Include(Item) + else + Exclude(Item); +end; + +constructor TheObjectVectorSet.Create(const AOwnObjects: Boolean); +begin + inherited Create; + FOwnObjects := AOwnObjects; +end; + +destructor TheObjectVectorSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheObjectVectorSet.Compare(const A, B: TItem): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheObjectVectorSet.Exclude(const Item: TItem): Boolean; +var Index: Integer; +begin + Result := Find(Item, Index); + if Result then + Extract(Index); +end; + +function TheObjectVectorSet.GetEnumerator: TEnumerator; +begin + Result.Init(-1, @MoveNext, @GetCurrent); +end; + +function TheObjectVectorSet.Include(const Item: TItem): Boolean; +var Index: Integer; +begin + if Find(Item, Index) then + Exit(True); + Insert(Index, Item); + Result := False; +end; + +function TheObjectVectorSet.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent); +end; + +procedure TheObjectVectorSet.Clear; +var I: Integer; +begin + if OwnObjects then + for I := 0 to Count - 1 do + FData[I].Free; + FCount := 0; + Capacity := 0; +end; + +procedure TheObjectVectorSet.Kill; +begin + OwnObjects := False; + Free; +end; + +procedure TheObjectVectorSet.Pack; +begin + Capacity := Count; +end; + +procedure TheObjectVectorSet.Wipe; +begin + FCount := 0; +end; + +{ TheVectorMap } + +function TheVectorMap.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean; +var L, H: Integer; +begin + Assert(@AKey = @AKey); // hint off + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + if AKey < FData[Index].Key then + H := Index - 1 + else if AKey = FData[Index].Key then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheVectorMap.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheVectorMap.GetItem(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheVectorMap.GetMap(const AKey: TKey): TValue; +var Index: Integer; +begin + if Find(AKey, Index) then + Exit(FData[Index].Value); + Result := MissingKeyValue(AKey); +end; + +function TheVectorMap.GetKey(const Index: Integer): TKey; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Key; +end; + +function TheVectorMap.GetCurrentKey(var Index: Integer): TKey; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Key; +end; + +function TheVectorMap.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheVectorMap.GetValue(const Index: Integer): TValue; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Value; +end; + +function TheVectorMap.GetCurrentValue(var Index: Integer): TValue; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Value; +end; + +procedure TheVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index].Key := AKey; + FData[Index].Value := AValue; +end; + +function TheVectorMap.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheVectorMap.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheVectorMap.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheVectorMap.SetMap(const AKey: TKey; const AValue: TValue); +var Index: Integer; +begin + if Find(AKey, Index) then + FData[Index].Value := AValue + else + Insert(Index, AKey, AValue); +end; + +function TheVectorMap.MissingKeyValue(const AKey: TKey): TValue; +begin + Assert(@AKey = @AKey); // hint off + Initialize(Result); // hint off + raise EMapKeyNotFound.Create(ClassName); +end; + +destructor TheVectorMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheVectorMap.Has(const AKey: TKey): Boolean; +var Index: Integer; +begin + Result := Find(AKey, Index); +end; + +function TheVectorMap.IndexOf(const AKey: TKey): Integer; +begin + if not Find(AKey, Result) then + Result := -1; +end; + +function TheVectorMap.Keys: TKeyEnumeratorProvider; +begin + Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey); +end; + +function TheVectorMap.KeysReversed: TKeyEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey); +end; + +function TheVectorMap.Remove(const AKey: TKey): Integer; +begin + if Find(AKey, Result) then + Delete(Result) + else + Result := -1; +end; + +function TheVectorMap.Values: TValueEnumeratorProvider; +begin + Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue); +end; + +function TheVectorMap.ValuesReversed: TValueEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue); +end; + +procedure TheVectorMap.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheVectorMap.Delete(const Index: Integer); +begin + Assert((Index >= 0) and (Index < Count)); + Extract(Index); +end; + +procedure TheVectorMap.Pack; +begin + Capacity := Count; +end; + +{ TheCmpVectorMap } + +function TheCmpVectorMap.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index]); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheCmpVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean; +var L, H, Cmp: Integer; +begin + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + Cmp := Compare(AKey, FData[Index].Key); + if Cmp < 0 then + H := Index - 1 + else if Cmp = 0 then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheCmpVectorMap.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheCmpVectorMap.GetItem(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheCmpVectorMap.GetMap(const AKey: TKey): TValue; +var Index: Integer; +begin + if Find(AKey, Index) then + Exit(FData[Index].Value); + Result := MissingKeyValue(AKey); +end; + +function TheCmpVectorMap.GetKey(const Index: Integer): TKey; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Key; +end; + +function TheCmpVectorMap.GetCurrentKey(var Index: Integer): TKey; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Key; +end; + +function TheCmpVectorMap.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheCmpVectorMap.GetValue(const Index: Integer): TValue; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Value; +end; + +function TheCmpVectorMap.GetCurrentValue(var Index: Integer): TValue; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Value; +end; + +procedure TheCmpVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index]); + FData[Index].Key := AKey; + FData[Index].Value := AValue; +end; + +function TheCmpVectorMap.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheCmpVectorMap.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheCmpVectorMap.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheCmpVectorMap.SetMap(const AKey: TKey; const AValue: TValue); +var Index: Integer; +begin + if Find(AKey, Index) then + FData[Index].Value := AValue + else + Insert(Index, AKey, AValue); +end; + +function TheCmpVectorMap.MissingKeyValue(const AKey: TKey): TValue; +begin + Assert(@AKey = @AKey); // hint off + Initialize(Result); // hint off + raise EMapKeyNotFound.Create(ClassName); +end; + +destructor TheCmpVectorMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheCmpVectorMap.Compare(const A, B: TKey): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheCmpVectorMap.Has(const AKey: TKey): Boolean; +var Index: Integer; +begin + Result := Find(AKey, Index); +end; + +function TheCmpVectorMap.IndexOf(const AKey: TKey): Integer; +begin + if not Find(AKey, Result) then + Result := -1; +end; + +function TheCmpVectorMap.Keys: TKeyEnumeratorProvider; +begin + Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey); +end; + +function TheCmpVectorMap.KeysReversed: TKeyEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey); +end; + +function TheCmpVectorMap.Remove(const AKey: TKey): Integer; +begin + if Find(AKey, Result) then + Delete(Result) + else + Result := -1; +end; + +function TheCmpVectorMap.Values: TValueEnumeratorProvider; +begin + Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue); +end; + +function TheCmpVectorMap.ValuesReversed: TValueEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue); +end; + +procedure TheCmpVectorMap.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do + Finalize(FData[I]); + FCount := 0; + Capacity := 0; +end; + +procedure TheCmpVectorMap.Delete(const Index: Integer); +begin + Assert((Index >= 0) and (Index < Count)); + Extract(Index); +end; + +procedure TheCmpVectorMap.Pack; +begin + Capacity := Count; +end; + +{ TheObjectVectorMap } + +function TheObjectVectorMap.Extract(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; + Dec(FCount); + Finalize(FData[Index].Key); + Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem)); +end; + +function TheObjectVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean; +var L, H, Cmp: Integer; +begin + L := 0; + H := Count - 1; + while L <= H do begin + Index := (L + H) shr 1; + Cmp := Compare(AKey, FData[Index].Key); + if Cmp < 0 then + H := Index - 1 + else if Cmp = 0 then + Exit(True) + else + L := Index + 1; + end; + Index := L; + Result := False; +end; + +function TheObjectVectorMap.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := FData[0]; +end; + +function TheObjectVectorMap.GetItem(const Index: Integer): TItem; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index]; +end; + +function TheObjectVectorMap.GetMap(const AKey: TKey): TValue; +var Index: Integer; +begin + if Find(AKey, Index) then + Exit(FData[Index].Value); + Result := MissingKeyValue(AKey); +end; + +function TheObjectVectorMap.GetKey(const Index: Integer): TKey; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Key; +end; + +function TheObjectVectorMap.GetCurrentKey(var Index: Integer): TKey; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Key; +end; + +function TheObjectVectorMap.GetLast: TItem; +begin + Assert(Count <> 0); + Result := FData[Count - 1]; +end; + +function TheObjectVectorMap.GetValue(const Index: Integer): TValue; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Value; +end; + +function TheObjectVectorMap.GetCurrentValue(var Index: Integer): TValue; +begin + Assert((Index >= 0) and (Index < Count)); + Result := FData[Index].Value; +end; + +procedure TheObjectVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue); +begin + Assert((Index >= 0) and (Index <= Count)); + if Count = Capacity then + Capacity := 2 * (Count + 1); + Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem)); + Inc(FCount); + Initialize(FData[Index].Key); + FData[Index].Key := AKey; + FData[Index].Value := AValue; +end; + +function TheObjectVectorMap.MoveNext(var Index: Integer): Boolean; +begin + Inc(Index); + Result := Index < Count; +end; + +function TheObjectVectorMap.MovePrev(var Index: Integer): Boolean; +begin + Dec(Index); + Result := Index >= 0; +end; + +procedure TheObjectVectorMap.SetCapacity(AValue: Integer); +begin + Assert(AValue >= 0); + if AValue = Capacity then + Exit; + if AValue < Count then + AValue := Count; + ReAllocMem(FData, AValue * SizeOf(FData[0])); + FCapacity := AValue; +end; + +procedure TheObjectVectorMap.SetMap(const AKey: TKey; const AValue: TValue); +var Index: Integer; +begin + if Find(AKey, Index) then + FData[Index].Value := AValue + else + Insert(Index, AKey, AValue); +end; + +function TheObjectVectorMap.MissingKeyValue(const AKey: TKey): TValue; +begin + Assert(@AKey = @AKey); // hint off + Initialize(Result); // hint off + raise EMapKeyNotFound.Create(ClassName); +end; + +constructor TheObjectVectorMap.Create(const AOwnObjects: Boolean); +begin + inherited Create; + FOwnObjects := AOwnObjects; +end; + +destructor TheObjectVectorMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheObjectVectorMap.Compare(const A, B: TKey): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheObjectVectorMap.Has(const AKey: TKey): Boolean; +var Index: Integer; +begin + Result := Find(AKey, Index); +end; + +function TheObjectVectorMap.IndexOf(const AKey: TKey): Integer; +begin + if not Find(AKey, Result) then + Result := -1; +end; + +function TheObjectVectorMap.Keys: TKeyEnumeratorProvider; +begin + Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey); +end; + +function TheObjectVectorMap.KeysReversed: TKeyEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey); +end; + +function TheObjectVectorMap.Remove(const AKey: TKey): Integer; +begin + if Find(AKey, Result) then + Delete(Result) + else + Result := -1; +end; + +function TheObjectVectorMap.Values: TValueEnumeratorProvider; +begin + Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue); +end; + +function TheObjectVectorMap.ValuesReversed: TValueEnumeratorProvider; +begin + Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue); +end; + +procedure TheObjectVectorMap.Clear; +var I: Integer; +begin + for I := 0 to Count - 1 do begin + Finalize(FData[I].Key); + if OwnObjects then + FData[I].Value.Free; + end; + FCount := 0; + Capacity := 0; +end; + +procedure TheObjectVectorMap.Delete(const Index: Integer); +begin + Assert((Index >= 0) and (Index < Count)); + Extract(Index); +end; + +procedure TheObjectVectorMap.Pack; +begin + Capacity := Count; +end; + +{ TheList } + +destructor TheList.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheList.InsertAfter(const After: PNode; const AItem: TItem): PNode; +begin + Result := InsertAfter_(After, NewNode(AItem)); +end; + +function TheList.InsertAfter_(const After, Node: PNode): PNode; +var + Node_: PNode_ absolute Node; + After_: PNode_ absolute After; +begin + if After^.Next = nil then + FLast := Node + else + After_^.FNext^.FPrev := Node_; + Node_^.FNext := After_^.FNext; + After_^.FNext := Node_; + Node_^.FPrev := After_; + Inc(FCount); + Result := Node; +end; + +function TheList.InsertBack(const Node: PNode): PNode; +var Node_: PNode_ absolute Node; +begin + if Last = nil then begin + FFirst := Node; + FLast := Node; + Node_^.FPrev := nil; + Node_^.FNext := nil; + FCount := 1; + Exit(Node); + end; + Result := InsertAfter_(Last, Node); +end; + +function TheList.InsertBefore(const AItem: TItem; const Before: PNode): PNode; +begin + Result := InsertBefore_(NewNode(AItem), Before); +end; + +function TheList.InsertBefore_(const Node, Before: PNode): PNode; +var + Node_: PNode_ absolute Node; + Before_: PNode_ absolute Before; +begin + if Before_^.FPrev = nil then + FFirst := Node + else + Before_^.FPrev^.FNext := Node_; + Node_^.FPrev := Before_^.FPrev; + Before_^.FPrev := Node_; + Node_^.FNext := Before_; + Inc(FCount); + Result := Node; +end; + +function TheList.InsertFront(const Node: PNode): PNode; +var Node_: PNode_ absolute Node; +begin + if First = nil then begin + FFirst := Node; + FLast := Node; + Node_^.FPrev := nil; + Node_^.FNext := nil; + FCount := 1; + Exit(Node); + end; + Result := InsertBefore_(Node, First); +end; + +function TheList.MoveToBack(const Node: PNode): PNode; +begin + Result := InsertBack(Extract(Node)); +end; + +function TheList.MoveToFront(const Node: PNode): PNode; +begin + Result := InsertFront(Extract(Node)); +end; + +function TheList.NewNode(const AItem: TItem): PNode; +var Node_: PNode_ absolute Result; +begin + New(Result); + Node_^.FPrev := nil; + Node_^.FNext := nil; + Result^.Item := AItem; +end; + +function TheList.PushBack(const AItem: TItem): PNode; +begin + Result := InsertBack(NewNode(AItem)); +end; + +function TheList.PushFront(const AItem: TItem): PNode; +begin + Result := InsertFront(NewNode(AItem)); +end; + +function TheList.Extract(const Node: PNode): PNode; +var Node_: PNode_ absolute Node; +begin + if Node^.Prev = nil then + FFirst := Node^.Next + else + Node_^.FPrev^.FNext := Node_^.FNext; + if Node^.Next = nil then + FLast := Node^.Prev + else + Node_^.FNext^.FPrev := Node_^.FPrev; + Node_^.FPrev := nil; + Node_^.FNext := nil; + Dec(FCount); + Result := Node; +end; + +function TheList.NewIterator: TIterator; +begin + Result.List := Self; + Result.Node := nil; +end; + +function TheList.GetEnumerator: TEnumerator; +begin + Result.Init(NewIterator, @MoveNext, @CurrentItem); +end; + +function TheList.CurrentItem(var Iterator: TIterator): TItem; +begin + Result := Iterator.Node^.Item; +end; + +function TheList.MoveNext(var Iterator: TIterator): Boolean; +begin + if Iterator.Node <> nil then begin + Iterator.Node := Iterator.Node^.Next; + if Iterator.Node <> nil then + Exit(True); + Iterator.List := nil; + Exit(False); + end; + if Iterator.List <> nil then + Iterator.Node := PNode(TheList(Iterator.List).First); + Result := Iterator.Node <> nil; +end; + +function TheList.MovePrev(var Iterator: TIterator): Boolean; +begin + if Iterator.Node <> nil then begin + Iterator.Node := Iterator.Node^.Prev; + if Iterator.Node <> nil then + Exit(True); + Iterator.List := nil; + Exit(False); + end; + if Iterator.List <> nil then + Iterator.Node := PNode(TheList(Iterator.List).Last); + Result := Iterator.Node <> nil; +end; + +function TheList.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(NewIterator, @MovePrev, @CurrentItem); +end; + +function TheList.MoveAfter(const After, Node: PNode): PNode; +begin + Assert(After <> Node); + Result := InsertAfter_(After, Extract(Node)); +end; + +function TheList.MoveBefore(const Node, Before: PNode): PNode; +begin + Assert(Node <> Before); + Result := InsertBefore_(Extract(Node), Before); +end; + +procedure TheList.Remove(Node: PNode); +begin + Extract(Node); + Dispose(Node); +end; + +procedure TheList.Clear; +var Node, Next: PNode; +begin + Node := First; + while Node <> nil do begin + Next := Node^.Next; + Dispose(Node); + Node := Next; + end; + FFirst := nil; + FLast := nil; + FCount := 0; +end; + +{ TheObjectList } + +destructor TheObjectList.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheObjectList.InsertAfter(const After: PNode; const AItem: TItem): PNode; +begin + Result := InsertAfter_(After, NewNode(AItem)); +end; + +function TheObjectList.InsertAfter_(const After, Node: PNode): PNode; +var + Node_: PNode_ absolute Node; + After_: PNode_ absolute After; +begin + if After^.Next = nil then + FLast := Node + else + After_^.FNext^.FPrev := Node_; + Node_^.FNext := After_^.FNext; + After_^.FNext := Node_; + Node_^.FPrev := After_; + Inc(FCount); + Result := Node; +end; + +function TheObjectList.InsertBack(const Node: PNode): PNode; +var Node_: PNode_ absolute Node; +begin + if Last = nil then begin + FFirst := Node; + FLast := Node; + Node_^.FPrev := nil; + Node_^.FNext := nil; + FCount := 1; + Exit(Node); + end; + Result := InsertAfter_(Last, Node); +end; + +function TheObjectList.InsertBefore(const AItem: TItem; const Before: PNode): PNode; +begin + Result := InsertBefore_(NewNode(AItem), Before); +end; + +function TheObjectList.InsertBefore_(const Node, Before: PNode): PNode; +var + Node_: PNode_ absolute Node; + Before_: PNode_ absolute Before; +begin + if Before_^.FPrev = nil then + FFirst := Node + else + Before_^.FPrev^.FNext := Node_; + Node_^.FPrev := Before_^.FPrev; + Before_^.FPrev := Node_; + Node_^.FNext := Before_; + Inc(FCount); + Result := Node; +end; + +function TheObjectList.InsertFront(const Node: PNode): PNode; +var Node_: PNode_ absolute Node; +begin + if First = nil then begin + FFirst := Node; + FLast := Node; + Node_^.FPrev := nil; + Node_^.FNext := nil; + FCount := 1; + Exit(Node); + end; + Result := InsertBefore_(Node, First); +end; + +function TheObjectList.MoveToBack(const Node: PNode): PNode; +begin + Result := InsertBack(Extract(Node)); +end; + +function TheObjectList.MoveToFront(const Node: PNode): PNode; +begin + Result := InsertFront(Extract(Node)); +end; + +function TheObjectList.NewNode(const AItem: TItem): PNode; +var Node_: PNode_ absolute Result; +begin + New(Result); + Node_^.FPrev := nil; + Node_^.FNext := nil; + Result^.Item := AItem; +end; + +function TheObjectList.PushBack(const AItem: TItem): PNode; +begin + Result := InsertBack(NewNode(AItem)); +end; + +function TheObjectList.PushFront(const AItem: TItem): PNode; +begin + Result := InsertFront(NewNode(AItem)); +end; + +function TheObjectList.Extract(const Node: PNode): PNode; +var Node_: PNode_ absolute Node; +begin + if Node^.Prev = nil then + FFirst := Node^.Next + else + Node_^.FPrev^.FNext := Node_^.FNext; + if Node^.Next = nil then + FLast := Node^.Prev + else + Node_^.FNext^.FPrev := Node_^.FPrev; + Node_^.FPrev := nil; + Node_^.FNext := nil; + Dec(FCount); + Result := Node; +end; + +function TheObjectList.NewIterator: TIterator; +begin + Result.List := Self; + Result.Node := nil; +end; + +function TheObjectList.GetEnumerator: TEnumerator; +begin + Result.Init(NewIterator, @MoveNext, @CurrentItem); +end; + +function TheObjectList.CurrentItem(var Iterator: TIterator): TItem; +begin + Result := Iterator.Node^.Item; +end; + +function TheObjectList.MoveNext(var Iterator: TIterator): Boolean; +begin + if Iterator.Node <> nil then begin + Iterator.Node := Iterator.Node^.Next; + if Iterator.Node <> nil then + Exit(True); + Iterator.List := nil; + Exit(False); + end; + if Iterator.List <> nil then + Iterator.Node := PNode(TheObjectList(Iterator.List).First); + Result := Iterator.Node <> nil; +end; + +function TheObjectList.MovePrev(var Iterator: TIterator): Boolean; +begin + if Iterator.Node <> nil then begin + Iterator.Node := Iterator.Node^.Prev; + if Iterator.Node <> nil then + Exit(True); + Iterator.List := nil; + Exit(False); + end; + if Iterator.List <> nil then + Iterator.Node := PNode(TheObjectList(Iterator.List).Last); + Result := Iterator.Node <> nil; +end; + +function TheObjectList.Reversed: TEnumeratorProvider; +begin + Result.FEnumerator.Init(NewIterator, @MovePrev, @CurrentItem); +end; + +function TheObjectList.MoveAfter(const After, Node: PNode): PNode; +begin + Assert(After <> Node); + Result := InsertAfter_(After, Extract(Node)); +end; + +function TheObjectList.MoveBefore(const Node, Before: PNode): PNode; +begin + Assert(Node <> Before); + Result := InsertBefore_(Extract(Node), Before); +end; + +procedure TheObjectList.Remove(Node: PNode); +begin + Extract(Node); + if OwnObjects then + Node^.Item.Free; + Dispose(Node); +end; + +constructor TheObjectList.Create(const AOwnObjects: Boolean); +begin + inherited Create; + FOwnObjects := AOwnObjects; +end; + +procedure TheObjectList.Clear; +var Node, Next: PNode; +begin + Node := First; + while Node <> nil do begin + if OwnObjects then + Node^.Item.Free; + Next := Node^.Next; + Dispose(Node); + Node := Next; + end; + FFirst := nil; + FLast := nil; + FCount := 0; +end; + +// BTrees section, keep last =================================================== + +{$R- do not remove, required for BTrees implementation} + +{ TheBTreeSet } + +procedure TheBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); +begin + Left := nil; + Right := nil; + if ParentIndex >= 0 then begin + if ParentIndex > 0 then + Left := PIndex(Parent)^.Index[ParentIndex - 1].Child; + if ParentIndex < Parent^.Count then + Right := PIndex(Parent)^.Index[ParentIndex + 1].Child; + end; +end; + +procedure TheBTreeSet.Clear; +begin + if Root <> nil then begin + Clear(Root); + FCount := 0; + FFirst := nil; + FLast := nil; + FRoot := nil; + end; +end; + +procedure TheBTreeSet.Clear(const P: PPage); +var I: Integer; +begin + if P^.IsIndex then + for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn + Clear(PIndex(P)^.Index[I].Child) + else + for I := 0 to P^.Count - 1 do + Finalize(PData(P)^.Data[I]); + FreeMem(P); +end; + +procedure TheBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + MoveLeft(P, Right, Right^.Count); + if PData(Right)^.Next <> nil then + PData(Right)^.Next^.Prev := PData(P) + else + FLast := P; + PData(P)^.Next := PData(Right)^.Next; + FreeMem(Right); + if Parent^.Count > 1 then begin + ExtractIndex(Parent, ParentIndex); + PIndex(Parent)^.Index[ParentIndex].Child := P; + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +procedure TheBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer)); + P^.Count += Right^.Count + 1; + FreeMem(Right); + if Parent^.Count > 1 then begin + Parent^.Count -= 1; + if ParentIndex < Parent^.Count then + Move( + PIndex(Parent)^.Index[ParentIndex + 1].DataPage, + PIndex(Parent)^.Index[ParentIndex].DataPage, + 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer) + ); + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +constructor TheBTreeSet.Create(const AKIndex: Integer; const AKData: Integer); +begin + inherited Create; + FKIndex := Max(AKIndex, 2); + FKData := Max(AKData, 1); +end; + +destructor TheBTreeSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheBTreeSet.Exclude(const Item: TItem): Boolean; +var + Parent, P, DataPage: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Item, Index); + if Result then // Key found + if P^.IsIndex then begin + DataPage := PPage(PIndex(P)^.Index[Index].DataPage); + if DataPage^.Count > KData then + ExtractData(DataPage, 0) + else begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index + 1; + Parent := P; + P := PIndex(P)^.Index[ParentIndex].Child; + Result := False; + end; + end else begin + ExtractData(P, Index); + if P^.Count < KData then + if P <> Root then + Underflow(Parent, P, ParentIndex) + else if Count = 0 then + Clear; + end + else if P^.IsIndex then begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child; + end else + break; // give up + until Result +end; + +function TheBTreeSet.GetEnumerator: TEnumerator; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.Init(Iterator, @MoveNext, @GetCurrent); +end; + +function TheBTreeSet.Include(const Item: TItem): Boolean; +var + P, Parent: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + if Find(P, Item, Index) then // Key found + Exit(True); + + if P^.IsIndex then begin + if P^.Count > 2 * KIndex then + SplitIndex(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child + end else begin + if P^.Count < 2 * KData then // page is not full + InsertItem(P, Index, Item) + else // page is full + Overflow(Parent, P, ParentIndex, Index, Item); + Exit(False); + end; + until False + else begin // tree is empty + FRoot := InsertItem(Page(False), 0, Item); + FFirst := Root; + FLast := Root; + end; +end; + +function TheBTreeSet.Reversed: TEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem; +begin + Result := PData(P)^.Data[Index]; + Finalize(PData(P)^.Data[Index]); + P^.Count -= 1; + if Index < P^.Count then + Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + FCount -=1; +end; + +procedure TheBTreeSet.ExtractIndex(const P: PPage; const Index: Integer); +begin + P^.Count -= 1; + if Index < P^.Count then + Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer)); +end; + +function TheBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean; +type PItem = ^TItem; +var + L, H: Integer; + MidItem: PItem; + Mid: Integer absolute Index; +begin + Assert(@Item = @Item); // hint off + L := 0; + H := P^.Count - 1; + while L <= H do begin + Mid := (L + H) shr 1; + if P^.IsIndex then + MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0] + else + MidItem := @PData(P)^.Data[Mid]; + if Item > MidItem^ then + L := Mid + 1 + else if Item = MidItem^ then + Exit(True) + else + H := Mid - 1; + end; + Index := L; + Result := False; +end; + +function TheBTreeSet.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0]; +end; + +function TheBTreeSet.GetLast: TItem; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1]; +end; + +function TheBTreeSet.GetCurrent(var Iterator: TIterator): TItem; +begin + Result := Iterator.Page^.Data[Iterator.Index]; +end; + +function TheBTreeSet.GetMembership(const Item: TItem): Boolean; +var + P: PData; + Index: Integer; +begin + Result := Seek(Item, P, Index); +end; + +function TheBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if RangeFrom <= RangeTo then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheBTreeSet.Insert(const P: PPage; const Index: Integer): PPage; +begin + if Index < P^.Count then + if P^.IsIndex then + Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer)) + else + Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + Inc(P^.Count); + Result := P; +end; + +function TheBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; +begin + Result := Insert(P, Index); + PIndex(Result)^.Index[Index].DataPage := PData(DataPage); + PIndex(Result)^.Index[Index + 1].Child := Child; +end; + +function TheBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage; +begin + Result := Insert(P, Index); + Initialize(PData(P)^.Data[Index]); + PData(P)^.Data[Index] := Item; + Inc(FCount); +end; + +function TheBTreeSet.MoveNext(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Inc(Iterator.Index); + if Iterator.Index < PPage(Iterator.Page)^.Count then + Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index] <= Iterator.Sentinel)); + Iterator.Page := Iterator.Page^.Next; + Iterator.Index := -1; + end; + Result := False; +end; + +function TheBTreeSet.MovePrev(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Dec(Iterator.Index); + if Iterator.Index >= 0 then + Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index] >= Iterator.Sentinel)); + Iterator.Page := Iterator.Page^.Prev; + if Iterator.Page <> nil then + Iterator.Index := PPage(Iterator.Page)^.Count; + end; + Result := False; +end; + +procedure TheBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer); +begin + Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0])); + Left^.Count += N; + P^.Count -= N; +end; + +procedure TheBTreeSet.MoveRight(const P, Right: PPage; const N: Integer); +begin + Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0])); + Right^.Count += N; + P^.Count -= N; +end; + +procedure TheBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count < 2 * KData) then begin + MoveLeft(Left, P); + InsertItem(P, Index - 1, Item); + Exit; + end; + + if (Right <> nil) and (Right^.Count < 2 * KData) then begin + if Index < 2 * KData then begin + MoveRight(P, Right); + InsertItem(P, Index, Item) + end else + InsertItem(Right, 0, Item); + Exit; + end; + + SplitData(Parent, P, ParentIndex, Index, Item); +end; + +procedure TheBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean); +begin + if AValue then + Include(Item) + else + Exclude(Item); +end; + +function TheBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage; +begin + if IsIndex then begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer)); + PIndex(Result)^.Index[0].Child := LeftmostChild; + end else begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0])); + PData(Result)^.Prev := nil; + PData(Result)^.Next := nil; + end; + Result^.IsIndex := IsIndex; + Result^.Count := 0; +end; + +function TheBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean; +begin + Result := False; + P := PData(Root); + if P <> nil then begin // tree is non empty + repeat + Result := Find(PPage(P), Item, Index); + if Result then begin // Key found + if PPage(P)^.IsIndex then begin + P := PIndex(P)^.Index[Index].DataPage; + Index := 0; + end; + end else if PPage(P)^.IsIndex then + P := PData(PIndex(P)^.Index[Index].Child) + else + break; + until Result; + end; +end; + +procedure TheBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); +var Right: PPage; +begin + Right := Page(False); + if PData(P)^.Next <> nil then begin // P was not last + PData(Right)^.Next := PData(P)^.Next; + PData(Right)^.Next^.Prev := PData(Right); + end else // P was last + FLast := Right; + PData(P)^.Next := PData(Right); + PData(Right)^.Prev := PData(P); + Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0])); + P^.Count := KData; + Right^.Count := KData; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, Right, Right) + else + FRoot := Insert(Page(True, P), 0, Right, Right); + if Index > KData then + InsertItem(Right, Index - KData, Item) + else + InsertItem(P, Index, Item); +end; + +procedure TheBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Right: PPage; +begin + Right := Page(True); + Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer)); + P^.Count := KIndex; + Right^.Count := KIndex; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right) + else + FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right); + if Index > KIndex then begin + P := Right; + Index -= KIndex + 1; + end; +end; + +procedure TheBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then + MoveRight(Left, P) + else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then + MoveLeft(P, Right) + else if Left <> nil then + Concat(Parent, Left, P, ParentIndex - 1) + else + Concat(Parent, P, Right, ParentIndex); +end; + +procedure TheBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count > KIndex) then begin + Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer)); + PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child; + PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage; + P^.Count += 1; + Index += 1; + Left^.Count -= 1; + PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage; + Exit; + end; + + if (Right <> nil) and (Right^.Count > KIndex) then begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + P^.Count += 1; + PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child; + PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage; + Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer)); + Right^.Count -= 1; + Exit; + end; + + if Left <> nil then begin + Index += Left^.Count + 1; + ConcatIndex(Parent, Left, P, ParentIndex - 1); + P := Left; + Exit; + end; + + ConcatIndex(Parent, P, Right, ParentIndex); +end; + +{ TheBTreeMap } + +procedure TheBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); +begin + Left := nil; + Right := nil; + if ParentIndex >= 0 then begin + if ParentIndex > 0 then + Left := PIndex(Parent)^.Index[ParentIndex - 1].Child; + if ParentIndex < Parent^.Count then + Right := PIndex(Parent)^.Index[ParentIndex + 1].Child; + end; +end; + +procedure TheBTreeMap.Clear; +begin + if Root <> nil then begin + Clear(Root); + FCount := 0; + FFirst := nil; + FLast := nil; + FRoot := nil; + end; +end; + +procedure TheBTreeMap.Clear(const P: PPage); +var I: Integer; +begin + if P^.IsIndex then + for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn + Clear(PIndex(P)^.Index[I].Child) + else + for I := 0 to P^.Count - 1 do + Finalize(PData(P)^.Data[I]); + FreeMem(P); +end; + +procedure TheBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + MoveLeft(P, Right, Right^.Count); + if PData(Right)^.Next <> nil then + PData(Right)^.Next^.Prev := PData(P) + else + FLast := P; + PData(P)^.Next := PData(Right)^.Next; + FreeMem(Right); + if Parent^.Count > 1 then begin + ExtractIndex(Parent, ParentIndex); + PIndex(Parent)^.Index[ParentIndex].Child := P; + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +procedure TheBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer)); + P^.Count += Right^.Count + 1; + FreeMem(Right); + if Parent^.Count > 1 then begin + Parent^.Count -= 1; + if ParentIndex < Parent^.Count then + Move( + PIndex(Parent)^.Index[ParentIndex + 1].DataPage, + PIndex(Parent)^.Index[ParentIndex].DataPage, + 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer) + ); + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +constructor TheBTreeMap.Create(const AKIndex: Integer; const AKData: Integer); +begin + inherited Create; + FKIndex := Max(AKIndex, 2); + FKData := Max(AKData, 1); +end; + +function TheBTreeMap.Delete(const Key: TKey): Boolean; +var Dummy: TValue; +begin + Result := Extract(Key, Dummy); +end; + +destructor TheBTreeMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue; +begin + Result := PData(P)^.Data[Index].Value; + Finalize(PData(P)^.Data[Index]); + P^.Count -= 1; + if Index < P^.Count then + Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + FCount -=1; +end; + +procedure TheBTreeMap.ExtractIndex(const P: PPage; const Index: Integer); +begin + P^.Count -= 1; + if Index < P^.Count then + Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer)); +end; + +function TheBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean; +var + Parent, P, DataPage: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then begin + DataPage := PPage(PIndex(P)^.Index[Index].DataPage); + if DataPage^.Count > KData then + Value := ExtractData(DataPage, 0) + else begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index + 1; + Parent := P; + P := PIndex(P)^.Index[ParentIndex].Child; + Result := False; + end; + end else begin + Value := ExtractData(P, Index); + if P^.Count < KData then + if P <> Root then + Underflow(Parent, P, ParentIndex) + else if Count = 0 then + Clear; + end + else if P^.IsIndex then begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child; + end else + break; // give up + until Result +end; + +function TheBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean; +type PKey = ^TKey; +var + L, H: Integer; + MidKey: PKey; + Mid: Integer absolute Index; +begin + Assert(@Key = @Key); // hint offf + L := 0; + H := P^.Count - 1; + while L <= H do begin + Mid := (L + H) shr 1; + if P^.IsIndex then + MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key + else + MidKey := @PData(P)^.Data[Mid].Key; + if Key > MidKey^ then + L := Mid + 1 + else if Key = MidKey^ then + Exit(True) + else + H := Mid - 1; + end; + Index := L; + Result := False; +end; + +function TheBTreeMap.GetCurrent(var Iterator: TIterator): TValue; +begin + Result := Iterator.Page^.Data[Iterator.Index].Value; +end; + +function TheBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey; +begin + Result := Iterator.Page^.Data[Iterator.Index].Key; +end; + +function TheBTreeMap.GetFirst: TValue; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0].Value; +end; + +function TheBTreeMap.GetFirstKey: TKey; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0].Key; +end; + +function TheBTreeMap.GetLast: TValue; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1].Value; +end; + +function TheBTreeMap.GetLastKey: TKey; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1].Key; +end; + +function TheBTreeMap.GetMap(const Key: TKey): TValue; +begin + if not Get(Key, Result) then + Result := MissingKeyValue(Key); +end; + +function TheBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if RangeFrom <= RangeTo then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if RangeFrom <= RangeTo then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey); +end; + +function TheBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean; +var + P: PPage; + Index: Integer; +begin + Result := False; + P := Root; + if P <> nil then // tree is non empty + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then + Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value + else + Value := PData(P)^.Data[Index].Value + else if P^.IsIndex then + P := PIndex(P)^.Index[Index].Child + else + break; // give up + until Result; +end; + +function TheBTreeMap.Insert(const P: PPage; const Index: Integer): PPage; +begin + if Index < P^.Count then + if P^.IsIndex then + Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer)) + else + Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + Inc(P^.Count); + Result := P; +end; + +function TheBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; +begin + Result := Insert(P, Index); + PIndex(Result)^.Index[Index].DataPage := PData(DataPage); + PIndex(Result)^.Index[Index + 1].Child := Child; +end; + +function TheBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage; +begin + Result := Insert(P, Index); + Initialize(PData(P)^.Data[Index]); + PData(P)^.Data[Index].Key := Key; + PData(P)^.Data[Index].Value := Value; + Inc(FCount); +end; + +procedure TheBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer); +begin + Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0])); + Left^.Count += N; + P^.Count -= N; +end; + +function TheBTreeMap.MoveNext(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Inc(Iterator.Index); + if Iterator.Index < PPage(Iterator.Page)^.Count then + Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index].Key <= Iterator.Sentinel)); + Iterator.Page := Iterator.Page^.Next; + Iterator.Index := -1; + end; + Result := False; +end; + +function TheBTreeMap.MovePrev(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Dec(Iterator.Index); + if Iterator.Index >= 0 then + Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index].Key >= Iterator.Sentinel)); + Iterator.Page := Iterator.Page^.Prev; + if Iterator.Page <> nil then + Iterator.Index := PPage(Iterator.Page)^.Count; + end; + Result := False; +end; + +procedure TheBTreeMap.MoveRight(const P, Right: PPage; const N: Integer); +begin + Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0])); + Right^.Count += N; + P^.Count -= N; +end; + +procedure TheBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count < 2 * KData) then begin + MoveLeft(Left, P); + InsertItem(P, Index - 1, Key, Value); + Exit; + end; + + if (Right <> nil) and (Right^.Count < 2 * KData) then begin + if Index < 2 * KData then begin + MoveRight(P, Right); + InsertItem(P, Index, Key, Value) + end else + InsertItem(Right, 0, Key, Value); + Exit; + end; + + SplitData(Parent, P, ParentIndex, Index, Key, Value); +end; + +procedure TheBTreeMap.SetMap(const Key: TKey; const Value: TValue); +begin + Put(Key, Value); +end; + +function TheBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage; +begin + if IsIndex then begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer)); + PIndex(Result)^.Index[0].Child := LeftmostChild; + end else begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0])); + PData(Result)^.Prev := nil; + PData(Result)^.Next := nil; + end; + Result^.IsIndex := IsIndex; + Result^.Count := 0; +end; + +function TheBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean; +begin + Result := False; + P := PData(Root); + if P <> nil then begin // tree is non empty + repeat + Result := Find(PPage(P), Key, Index); + if Result then begin // Key found + if PPage(P)^.IsIndex then begin + P := PIndex(P)^.Index[Index].DataPage; + Index := 0; + end; + end else if PPage(P)^.IsIndex then + P := PData(PIndex(P)^.Index[Index].Child) + else + break; + until Result; + end; +end; + +function TheBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean; +var Dummy: TValue; +begin + Result := Put(Key, Value, Dummy, CanOverwrite); +end; + +function TheBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean; +var + P, Parent: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then + Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite) + else + Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite) + else if P^.IsIndex then begin + if P^.Count > 2 * KIndex then + SplitIndex(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child + end else begin + if P^.Count < 2 * KData then // page is not full + InsertItem(P, Index, Key, Value) + else // page is full + Overflow(Parent, P, ParentIndex, Index, Key, Value); + break; + end; + until Result + else begin // tree is empty + FRoot := InsertItem(Page(False), 0, Key, Value); + FFirst := Root; + FLast := Root; + end; +end; + +function TheBTreeMap.Keys: TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey); +end; + +function TheBTreeMap.KeysReversed: TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey); +end; + +function TheBTreeMap.Values: TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); +end; + +function TheBTreeMap.ValuesReversed: TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +procedure TheBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); +var Right: PPage; +begin + Right := Page(False); + if PData(P)^.Next <> nil then begin // P was not last + PData(Right)^.Next := PData(P)^.Next; + PData(Right)^.Next^.Prev := PData(Right); + end else // P was last + FLast := Right; + PData(P)^.Next := PData(Right); + PData(Right)^.Prev := PData(P); + Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0])); + P^.Count := KData; + Right^.Count := KData; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, Right, Right) + else + FRoot := Insert(Page(True, P), 0, Right, Right); + if Index > KData then + InsertItem(Right, Index - KData, Key, Value) + else + InsertItem(P, Index, Key, Value); +end; + +procedure TheBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Right: PPage; +begin + Right := Page(True); + Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer)); + P^.Count := KIndex; + Right^.Count := KIndex; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right) + else + FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right); + if Index > KIndex then begin + P := Right; + Index -= KIndex + 1; + end; +end; + +procedure TheBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean); +begin + Prev := Dest; + if CanOverwrite then + Dest := Value; +end; + +procedure TheBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then + MoveRight(Left, P) + else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then + MoveLeft(P, Right) + else if Left <> nil then + Concat(Parent, Left, P, ParentIndex - 1) + else + Concat(Parent, P, Right, ParentIndex); +end; + +procedure TheBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count > KIndex) then begin + Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer)); + PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child; + PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage; + P^.Count += 1; + Index += 1; + Left^.Count -= 1; + PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage; + Exit; + end; + + if (Right <> nil) and (Right^.Count > KIndex) then begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + P^.Count += 1; + PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child; + PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage; + Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer)); + Right^.Count -= 1; + Exit; + end; + + if Left <> nil then begin + Index += Left^.Count + 1; + ConcatIndex(Parent, Left, P, ParentIndex - 1); + P := Left; + Exit; + end; + + ConcatIndex(Parent, P, Right, ParentIndex); +end; + +function TheBTreeMap.MissingKeyValue(const Key: TKey): TValue; +begin + Assert(@Key = @Key); // hint off + Initialize(Result); // hint off + raise EMapKeyNotFound.Create(ClassName); +end; + +{ TheCmpBTreeSet } + +procedure TheCmpBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); +begin + Left := nil; + Right := nil; + if ParentIndex >= 0 then begin + if ParentIndex > 0 then + Left := PIndex(Parent)^.Index[ParentIndex - 1].Child; + if ParentIndex < Parent^.Count then + Right := PIndex(Parent)^.Index[ParentIndex + 1].Child; + end; +end; + +procedure TheCmpBTreeSet.Clear; +begin + if Root <> nil then begin + Clear(Root); + FCount := 0; + FFirst := nil; + FLast := nil; + FRoot := nil; + end; +end; + +procedure TheCmpBTreeSet.Clear(const P: PPage); +var I: Integer; +begin + if P^.IsIndex then + for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn + Clear(PIndex(P)^.Index[I].Child) + else + for I := 0 to P^.Count - 1 do + Finalize(PData(P)^.Data[I]); + FreeMem(P); +end; + +procedure TheCmpBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + MoveLeft(P, Right, Right^.Count); + if PData(Right)^.Next <> nil then + PData(Right)^.Next^.Prev := PData(P) + else + FLast := P; + PData(P)^.Next := PData(Right)^.Next; + FreeMem(Right); + if Parent^.Count > 1 then begin + ExtractIndex(Parent, ParentIndex); + PIndex(Parent)^.Index[ParentIndex].Child := P; + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +procedure TheCmpBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer)); + P^.Count += Right^.Count + 1; + FreeMem(Right); + if Parent^.Count > 1 then begin + Parent^.Count -= 1; + if ParentIndex < Parent^.Count then + Move( + PIndex(Parent)^.Index[ParentIndex + 1].DataPage, + PIndex(Parent)^.Index[ParentIndex].DataPage, + 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer) + ); + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +constructor TheCmpBTreeSet.Create(const AKIndex: Integer; const AKData: Integer); +begin + inherited Create; + FKIndex := Max(AKIndex, 2); + FKData := Max(AKData, 1); +end; + +destructor TheCmpBTreeSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheCmpBTreeSet.Compare(const A, B: TItem): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheCmpBTreeSet.Exclude(const Item: TItem): Boolean; +var + Parent, P, DataPage: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Item, Index); + if Result then // Key found + if P^.IsIndex then begin + DataPage := PPage(PIndex(P)^.Index[Index].DataPage); + if DataPage^.Count > KData then + ExtractData(DataPage, 0) + else begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index + 1; + Parent := P; + P := PIndex(P)^.Index[ParentIndex].Child; + Result := False; + end; + end else begin + ExtractData(P, Index); + if P^.Count < KData then + if P <> Root then + Underflow(Parent, P, ParentIndex) + else if Count = 0 then + Clear; + end + else if P^.IsIndex then begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child; + end else + break; // give up + until Result +end; + +function TheCmpBTreeSet.GetEnumerator: TEnumerator; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.Init(Iterator, @MoveNext, @GetCurrent); +end; + +function TheCmpBTreeSet.Include(const Item: TItem): Boolean; +var + P, Parent: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + if Find(P, Item, Index) then // Key found + Exit(True); + + if P^.IsIndex then begin + if P^.Count > 2 * KIndex then + SplitIndex(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child + end else begin + if P^.Count < 2 * KData then // page is not full + InsertItem(P, Index, Item) + else // page is full + Overflow(Parent, P, ParentIndex, Index, Item); + Exit(False); + end; + until False + else begin // tree is empty + FRoot := InsertItem(Page(False), 0, Item); + FFirst := Root; + FLast := Root; + end; +end; + +function TheCmpBTreeSet.Reversed: TEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheCmpBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem; +begin + Result := PData(P)^.Data[Index]; + Finalize(PData(P)^.Data[Index]); + P^.Count -= 1; + if Index < P^.Count then + Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + FCount -=1; +end; + +procedure TheCmpBTreeSet.ExtractIndex(const P: PPage; const Index: Integer); +begin + P^.Count -= 1; + if Index < P^.Count then + Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer)); +end; + +function TheCmpBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean; +type PItem = ^TItem; +var + L, H, Cmp: Integer; + MidItem: PItem; + Mid: Integer absolute Index; +begin + L := 0; + H := P^.Count - 1; + while L <= H do begin + Mid := (L + H) shr 1; + if P^.IsIndex then + MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0] + else + MidItem := @PData(P)^.Data[Mid]; + Cmp := Compare(Item, MidItem^); + if Cmp > 0 then + L := Mid + 1 + else if Cmp = 0 then + Exit(True) + else + H := Mid - 1; + end; + Index := L; + Result := False; +end; + +function TheCmpBTreeSet.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0]; +end; + +function TheCmpBTreeSet.GetLast: TItem; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1]; +end; + +function TheCmpBTreeSet.GetCurrent(var Iterator: TIterator): TItem; +begin + Result := Iterator.Page^.Data[Iterator.Index]; +end; + +function TheCmpBTreeSet.GetMembership(const Item: TItem): Boolean; +var + P: PData; + Index: Integer; +begin + Result := Seek(Item, P, Index); +end; + +function TheCmpBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if Compare(RangeFrom, RangeTo) <= 0 then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheCmpBTreeSet.Insert(const P: PPage; const Index: Integer): PPage; +begin + if Index < P^.Count then + if P^.IsIndex then + Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer)) + else + Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + Inc(P^.Count); + Result := P; +end; + +function TheCmpBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; +begin + Result := Insert(P, Index); + PIndex(Result)^.Index[Index].DataPage := PData(DataPage); + PIndex(Result)^.Index[Index + 1].Child := Child; +end; + +function TheCmpBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage; +begin + Result := Insert(P, Index); + Initialize(PData(P)^.Data[Index]); + PData(P)^.Data[Index] := Item; + Inc(FCount); +end; + +function TheCmpBTreeSet.MoveNext(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Inc(Iterator.Index); + if Iterator.Index < PPage(Iterator.Page)^.Count then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) <= 0)); + Iterator.Page := Iterator.Page^.Next; + Iterator.Index := -1; + end; + Result := False; +end; + +function TheCmpBTreeSet.MovePrev(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Dec(Iterator.Index); + if Iterator.Index >= 0 then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) >= 0)); + Iterator.Page := Iterator.Page^.Prev; + if Iterator.Page <> nil then + Iterator.Index := PPage(Iterator.Page)^.Count; + end; + Result := False; +end; + +procedure TheCmpBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer); +begin + Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0])); + Left^.Count += N; + P^.Count -= N; +end; + +procedure TheCmpBTreeSet.MoveRight(const P, Right: PPage; const N: Integer); +begin + Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0])); + Right^.Count += N; + P^.Count -= N; +end; + +procedure TheCmpBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count < 2 * KData) then begin + MoveLeft(Left, P); + InsertItem(P, Index - 1, Item); + Exit; + end; + + if (Right <> nil) and (Right^.Count < 2 * KData) then begin + if Index < 2 * KData then begin + MoveRight(P, Right); + InsertItem(P, Index, Item) + end else + InsertItem(Right, 0, Item); + Exit; + end; + + SplitData(Parent, P, ParentIndex, Index, Item); +end; + +procedure TheCmpBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean); +begin + if AValue then + Include(Item) + else + Exclude(Item); +end; + +function TheCmpBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage; +begin + if IsIndex then begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer)); + PIndex(Result)^.Index[0].Child := LeftmostChild; + end else begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0])); + PData(Result)^.Prev := nil; + PData(Result)^.Next := nil; + end; + Result^.IsIndex := IsIndex; + Result^.Count := 0; +end; + +function TheCmpBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean; +begin + Result := False; + P := PData(Root); + if P <> nil then begin // tree is non empty + repeat + Result := Find(PPage(P), Item, Index); + if Result then begin // Key found + if PPage(P)^.IsIndex then begin + P := PIndex(P)^.Index[Index].DataPage; + Index := 0; + end; + end else if PPage(P)^.IsIndex then + P := PData(PIndex(P)^.Index[Index].Child) + else + break; + until Result; + end; +end; + +procedure TheCmpBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); +var Right: PPage; +begin + Right := Page(False); + if PData(P)^.Next <> nil then begin // P was not last + PData(Right)^.Next := PData(P)^.Next; + PData(Right)^.Next^.Prev := PData(Right); + end else // P was last + FLast := Right; + PData(P)^.Next := PData(Right); + PData(Right)^.Prev := PData(P); + Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0])); + P^.Count := KData; + Right^.Count := KData; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, Right, Right) + else + FRoot := Insert(Page(True, P), 0, Right, Right); + if Index > KData then + InsertItem(Right, Index - KData, Item) + else + InsertItem(P, Index, Item); +end; + +procedure TheCmpBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Right: PPage; +begin + Right := Page(True); + Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer)); + P^.Count := KIndex; + Right^.Count := KIndex; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right) + else + FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right); + if Index > KIndex then begin + P := Right; + Index -= KIndex + 1; + end; +end; + +procedure TheCmpBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then + MoveRight(Left, P) + else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then + MoveLeft(P, Right) + else if Left <> nil then + Concat(Parent, Left, P, ParentIndex - 1) + else + Concat(Parent, P, Right, ParentIndex); +end; + +procedure TheCmpBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count > KIndex) then begin + Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer)); + PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child; + PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage; + P^.Count += 1; + Index += 1; + Left^.Count -= 1; + PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage; + Exit; + end; + + if (Right <> nil) and (Right^.Count > KIndex) then begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + P^.Count += 1; + PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child; + PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage; + Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer)); + Right^.Count -= 1; + Exit; + end; + + if Left <> nil then begin + Index += Left^.Count + 1; + ConcatIndex(Parent, Left, P, ParentIndex - 1); + P := Left; + Exit; + end; + + ConcatIndex(Parent, P, Right, ParentIndex); +end; + +{ TheObjectBTreeSet } + +procedure TheObjectBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); +begin + Left := nil; + Right := nil; + if ParentIndex >= 0 then begin + if ParentIndex > 0 then + Left := PIndex(Parent)^.Index[ParentIndex - 1].Child; + if ParentIndex < Parent^.Count then + Right := PIndex(Parent)^.Index[ParentIndex + 1].Child; + end; +end; + +procedure TheObjectBTreeSet.Clear; +begin + if Root <> nil then begin + Clear(Root); + FCount := 0; + FFirst := nil; + FLast := nil; + FRoot := nil; + end; +end; + +procedure TheObjectBTreeSet.Clear(const P: PPage); +var I: Integer; +begin + if P^.IsIndex then + for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn + Clear(PIndex(P)^.Index[I].Child) + else if OwnObjects then + for I := 0 to P^.Count - 1 do + PData(P)^.Data[I].Free; + FreeMem(P); +end; + +procedure TheObjectBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + MoveLeft(P, Right, Right^.Count); + if PData(Right)^.Next <> nil then + PData(Right)^.Next^.Prev := PData(P) + else + FLast := P; + PData(P)^.Next := PData(Right)^.Next; + FreeMem(Right); + if Parent^.Count > 1 then begin + ExtractIndex(Parent, ParentIndex); + PIndex(Parent)^.Index[ParentIndex].Child := P; + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +procedure TheObjectBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer)); + P^.Count += Right^.Count + 1; + FreeMem(Right); + if Parent^.Count > 1 then begin + Parent^.Count -= 1; + if ParentIndex < Parent^.Count then + Move( + PIndex(Parent)^.Index[ParentIndex + 1].DataPage, + PIndex(Parent)^.Index[ParentIndex].DataPage, + 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer) + ); + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +constructor TheObjectBTreeSet.Create(const AOwnObjects: Boolean; const AKIndex: Integer; const AKData: Integer); +begin + inherited Create; + FOwnObjects := AOwnObjects; + FKIndex := Max(AKIndex, 2); + FKData := Max(AKData, 1); +end; + +destructor TheObjectBTreeSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheObjectBTreeSet.Compare(const A, B: TItem): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheObjectBTreeSet.Exclude(const Item: TItem): Boolean; +var + Parent, P, DataPage: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Item, Index); + if Result then // Key found + if P^.IsIndex then begin + DataPage := PPage(PIndex(P)^.Index[Index].DataPage); + if DataPage^.Count > KData then + ExtractData(DataPage, 0) + else begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index + 1; + Parent := P; + P := PIndex(P)^.Index[ParentIndex].Child; + Result := False; + end; + end else begin + ExtractData(P, Index); + if P^.Count < KData then + if P <> Root then + Underflow(Parent, P, ParentIndex) + else if Count = 0 then + Clear; + end + else if P^.IsIndex then begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child; + end else + break; // give up + until Result +end; + +function TheObjectBTreeSet.GetEnumerator: TEnumerator; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.Init(Iterator, @MoveNext, @GetCurrent); +end; + +function TheObjectBTreeSet.Include(const Item: TItem): Boolean; +var + P, Parent: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + if Find(P, Item, Index) then // Key found + Exit(True); + + if P^.IsIndex then begin + if P^.Count > 2 * KIndex then + SplitIndex(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child + end else begin + if P^.Count < 2 * KData then // page is not full + InsertItem(P, Index, Item) + else // page is full + Overflow(Parent, P, ParentIndex, Index, Item); + Exit(False); + end; + until False + else begin // tree is empty + FRoot := InsertItem(Page(False), 0, Item); + FFirst := Root; + FLast := Root; + end; +end; + +function TheObjectBTreeSet.Reversed: TEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheObjectBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem; +begin + Result := PData(P)^.Data[Index]; + P^.Count -= 1; + if Index < P^.Count then + Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + FCount -=1; +end; + +procedure TheObjectBTreeSet.ExtractIndex(const P: PPage; const Index: Integer); +begin + P^.Count -= 1; + if Index < P^.Count then + Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer)); +end; + +function TheObjectBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean; +type PItem = ^TItem; +var + L, H, Cmp: Integer; + MidItem: PItem; + Mid: Integer absolute Index; +begin + L := 0; + H := P^.Count - 1; + while L <= H do begin + Mid := (L + H) shr 1; + if P^.IsIndex then + MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0] + else + MidItem := @PData(P)^.Data[Mid]; + Cmp := Compare(Item, MidItem^); + if Cmp > 0 then + L := Mid + 1 + else if Cmp = 0 then + Exit(True) + else + H := Mid - 1; + end; + Index := L; + Result := False; +end; + +function TheObjectBTreeSet.GetFirst: TItem; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0]; +end; + +function TheObjectBTreeSet.GetLast: TItem; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1]; +end; + +function TheObjectBTreeSet.GetCurrent(var Iterator: TIterator): TItem; +begin + Result := Iterator.Page^.Data[Iterator.Index]; +end; + +function TheObjectBTreeSet.GetMembership(const Item: TItem): Boolean; +var + P: PData; + Index: Integer; +begin + Result := Seek(Item, P, Index); +end; + +function TheObjectBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if Compare(RangeFrom, RangeTo) <= 0 then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheObjectBTreeSet.Insert(const P: PPage; const Index: Integer): PPage; +begin + if Index < P^.Count then + if P^.IsIndex then + Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer)) + else + Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + Inc(P^.Count); + Result := P; +end; + +function TheObjectBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; +begin + Result := Insert(P, Index); + PIndex(Result)^.Index[Index].DataPage := PData(DataPage); + PIndex(Result)^.Index[Index + 1].Child := Child; +end; + +function TheObjectBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage; +begin + Result := Insert(P, Index); + PData(P)^.Data[Index] := Item; + Inc(FCount); +end; + +function TheObjectBTreeSet.MoveNext(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Inc(Iterator.Index); + if Iterator.Index < PPage(Iterator.Page)^.Count then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) <= 0)); + Iterator.Page := Iterator.Page^.Next; + Iterator.Index := -1; + end; + Result := False; +end; + +function TheObjectBTreeSet.MovePrev(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Dec(Iterator.Index); + if Iterator.Index >= 0 then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) >= 0)); + Iterator.Page := Iterator.Page^.Prev; + if Iterator.Page <> nil then + Iterator.Index := PPage(Iterator.Page)^.Count; + end; + Result := False; +end; + +procedure TheObjectBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer); +begin + Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0])); + Left^.Count += N; + P^.Count -= N; +end; + +procedure TheObjectBTreeSet.MoveRight(const P, Right: PPage; const N: Integer); +begin + Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0])); + Right^.Count += N; + P^.Count -= N; +end; + +procedure TheObjectBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count < 2 * KData) then begin + MoveLeft(Left, P); + InsertItem(P, Index - 1, Item); + Exit; + end; + + if (Right <> nil) and (Right^.Count < 2 * KData) then begin + if Index < 2 * KData then begin + MoveRight(P, Right); + InsertItem(P, Index, Item) + end else + InsertItem(Right, 0, Item); + Exit; + end; + + SplitData(Parent, P, ParentIndex, Index, Item); +end; + +procedure TheObjectBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean); +begin + if AValue then + Include(Item) + else + Exclude(Item); +end; + +function TheObjectBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage; +begin + if IsIndex then begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer)); + PIndex(Result)^.Index[0].Child := LeftmostChild; + end else begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0])); + PData(Result)^.Prev := nil; + PData(Result)^.Next := nil; + end; + Result^.IsIndex := IsIndex; + Result^.Count := 0; +end; + +function TheObjectBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean; +begin + Result := False; + P := PData(Root); + if P <> nil then begin // tree is non empty + repeat + Result := Find(PPage(P), Item, Index); + if Result then begin // Key found + if PPage(P)^.IsIndex then begin + P := PIndex(P)^.Index[Index].DataPage; + Index := 0; + end; + end else if PPage(P)^.IsIndex then + P := PData(PIndex(P)^.Index[Index].Child) + else + break; + until Result; + end; +end; + +procedure TheObjectBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem); +var Right: PPage; +begin + Right := Page(False); + if PData(P)^.Next <> nil then begin // P was not last + PData(Right)^.Next := PData(P)^.Next; + PData(Right)^.Next^.Prev := PData(Right); + end else // P was last + FLast := Right; + PData(P)^.Next := PData(Right); + PData(Right)^.Prev := PData(P); + Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0])); + P^.Count := KData; + Right^.Count := KData; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, Right, Right) + else + FRoot := Insert(Page(True, P), 0, Right, Right); + if Index > KData then + InsertItem(Right, Index - KData, Item) + else + InsertItem(P, Index, Item); +end; + +procedure TheObjectBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Right: PPage; +begin + Right := Page(True); + Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer)); + P^.Count := KIndex; + Right^.Count := KIndex; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right) + else + FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right); + if Index > KIndex then begin + P := Right; + Index -= KIndex + 1; + end; +end; + +procedure TheObjectBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then + MoveRight(Left, P) + else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then + MoveLeft(P, Right) + else if Left <> nil then + Concat(Parent, Left, P, ParentIndex - 1) + else + Concat(Parent, P, Right, ParentIndex); +end; + +procedure TheObjectBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count > KIndex) then begin + Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer)); + PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child; + PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage; + P^.Count += 1; + Index += 1; + Left^.Count -= 1; + PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage; + Exit; + end; + + if (Right <> nil) and (Right^.Count > KIndex) then begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + P^.Count += 1; + PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child; + PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage; + Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer)); + Right^.Count -= 1; + Exit; + end; + + if Left <> nil then begin + Index += Left^.Count + 1; + ConcatIndex(Parent, Left, P, ParentIndex - 1); + P := Left; + Exit; + end; + + ConcatIndex(Parent, P, Right, ParentIndex); +end; + +{ TheCmpBTreeMap } + +procedure TheCmpBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); +begin + Left := nil; + Right := nil; + if ParentIndex >= 0 then begin + if ParentIndex > 0 then + Left := PIndex(Parent)^.Index[ParentIndex - 1].Child; + if ParentIndex < Parent^.Count then + Right := PIndex(Parent)^.Index[ParentIndex + 1].Child; + end; +end; + +procedure TheCmpBTreeMap.Clear; +begin + if Root <> nil then begin + Clear(Root); + FCount := 0; + FFirst := nil; + FLast := nil; + FRoot := nil; + end; +end; + +procedure TheCmpBTreeMap.Clear(const P: PPage); +var I: Integer; +begin + if P^.IsIndex then + for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn + Clear(PIndex(P)^.Index[I].Child) + else + for I := 0 to P^.Count - 1 do + Finalize(PData(P)^.Data[I]); + FreeMem(P); +end; + +procedure TheCmpBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + MoveLeft(P, Right, Right^.Count); + if PData(Right)^.Next <> nil then + PData(Right)^.Next^.Prev := PData(P) + else + FLast := P; + PData(P)^.Next := PData(Right)^.Next; + FreeMem(Right); + if Parent^.Count > 1 then begin + ExtractIndex(Parent, ParentIndex); + PIndex(Parent)^.Index[ParentIndex].Child := P; + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +procedure TheCmpBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer)); + P^.Count += Right^.Count + 1; + FreeMem(Right); + if Parent^.Count > 1 then begin + Parent^.Count -= 1; + if ParentIndex < Parent^.Count then + Move( + PIndex(Parent)^.Index[ParentIndex + 1].DataPage, + PIndex(Parent)^.Index[ParentIndex].DataPage, + 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer) + ); + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +constructor TheCmpBTreeMap.Create(const AKIndex: Integer; const AKData: Integer); +begin + inherited Create; + FKIndex := Max(AKIndex, 2); + FKData := Max(AKData, 1); +end; + +function TheCmpBTreeMap.Delete(const Key: TKey): Boolean; +var Dummy: TValue; +begin + Result := Extract(Key, Dummy); +end; + +destructor TheCmpBTreeMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheCmpBTreeMap.Compare(const A, B: TKey): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheCmpBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue; +begin + Result := PData(P)^.Data[Index].Value; + Finalize(PData(P)^.Data[Index]); + P^.Count -= 1; + if Index < P^.Count then + Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + FCount -=1; +end; + +procedure TheCmpBTreeMap.ExtractIndex(const P: PPage; const Index: Integer); +begin + P^.Count -= 1; + if Index < P^.Count then + Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer)); +end; + +function TheCmpBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean; +var + Parent, P, DataPage: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then begin + DataPage := PPage(PIndex(P)^.Index[Index].DataPage); + if DataPage^.Count > KData then + Value := ExtractData(DataPage, 0) + else begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index + 1; + Parent := P; + P := PIndex(P)^.Index[ParentIndex].Child; + Result := False; + end; + end else begin + Value := ExtractData(P, Index); + if P^.Count < KData then + if P <> Root then + Underflow(Parent, P, ParentIndex) + else if Count = 0 then + Clear; + end + else if P^.IsIndex then begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child; + end else + break; // give up + until Result +end; + +function TheCmpBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean; +type PKey = ^TKey; +var + L, H, Cmp: Integer; + MidKey: PKey; + Mid: Integer absolute Index; +begin + L := 0; + H := P^.Count - 1; + while L <= H do begin + Mid := (L + H) shr 1; + if P^.IsIndex then + MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key + else + MidKey := @PData(P)^.Data[Mid].Key; + Cmp := Compare(Key, Midkey^); + if Cmp > 0 then + L := Mid + 1 + else if Cmp = 0 then + Exit(True) + else + H := Mid - 1; + end; + Index := L; + Result := False; +end; + +function TheCmpBTreeMap.GetCurrent(var Iterator: TIterator): TValue; +begin + Result := Iterator.Page^.Data[Iterator.Index].Value; +end; + +function TheCmpBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey; +begin + Result := Iterator.Page^.Data[Iterator.Index].Key; +end; + +function TheCmpBTreeMap.GetFirst: TValue; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0].Value; +end; + +function TheCmpBTreeMap.GetFirstKey: TKey; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0].Key; +end; + +function TheCmpBTreeMap.GetLast: TValue; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1].Value; +end; + +function TheCmpBTreeMap.GetLastKey: TKey; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1].Key; +end; + +function TheCmpBTreeMap.GetMap(const Key: TKey): TValue; +begin + if not Get(Key, Result) then + Result := MissingKeyValue(Key); +end; + +function TheCmpBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if Compare(RangeFrom, RangeTo) <= 0 then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheCmpBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if Compare(RangeFrom, RangeTo) <= 0 then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey); +end; + +function TheCmpBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean; +var + P: PPage; + Index: Integer; +begin + Result := False; + P := Root; + if P <> nil then // tree is non empty + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then + Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value + else + Value := PData(P)^.Data[Index].Value + else if P^.IsIndex then + P := PIndex(P)^.Index[Index].Child + else + break; // give up + until Result; +end; + +function TheCmpBTreeMap.Insert(const P: PPage; const Index: Integer): PPage; +begin + if Index < P^.Count then + if P^.IsIndex then + Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer)) + else + Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + Inc(P^.Count); + Result := P; +end; + +function TheCmpBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; +begin + Result := Insert(P, Index); + PIndex(Result)^.Index[Index].DataPage := PData(DataPage); + PIndex(Result)^.Index[Index + 1].Child := Child; +end; + +function TheCmpBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage; +begin + Result := Insert(P, Index); + Initialize(PData(P)^.Data[Index]); + PData(P)^.Data[Index].Key := Key; + PData(P)^.Data[Index].Value := Value; + Inc(FCount); +end; + +procedure TheCmpBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer); +begin + Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0])); + Left^.Count += N; + P^.Count -= N; +end; + +function TheCmpBTreeMap.MoveNext(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Inc(Iterator.Index); + if Iterator.Index < PPage(Iterator.Page)^.Count then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) <= 0)); + Iterator.Page := Iterator.Page^.Next; + Iterator.Index := -1; + end; + Result := False; +end; + +function TheCmpBTreeMap.MovePrev(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Dec(Iterator.Index); + if Iterator.Index >= 0 then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) >= 0)); + Iterator.Page := Iterator.Page^.Prev; + if Iterator.Page <> nil then + Iterator.Index := PPage(Iterator.Page)^.Count; + end; + Result := False; +end; + +procedure TheCmpBTreeMap.MoveRight(const P, Right: PPage; const N: Integer); +begin + Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0])); + Right^.Count += N; + P^.Count -= N; +end; + +procedure TheCmpBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count < 2 * KData) then begin + MoveLeft(Left, P); + InsertItem(P, Index - 1, Key, Value); + Exit; + end; + + if (Right <> nil) and (Right^.Count < 2 * KData) then begin + if Index < 2 * KData then begin + MoveRight(P, Right); + InsertItem(P, Index, Key, Value) + end else + InsertItem(Right, 0, Key, Value); + Exit; + end; + + SplitData(Parent, P, ParentIndex, Index, Key, Value); +end; + +procedure TheCmpBTreeMap.SetMap(const Key: TKey; const Value: TValue); +begin + Put(Key, Value); +end; + +function TheCmpBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage; +begin + if IsIndex then begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer)); + PIndex(Result)^.Index[0].Child := LeftmostChild; + end else begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0])); + PData(Result)^.Prev := nil; + PData(Result)^.Next := nil; + end; + Result^.IsIndex := IsIndex; + Result^.Count := 0; +end; + +function TheCmpBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean; +begin + Result := False; + P := PData(Root); + if P <> nil then begin // tree is non empty + repeat + Result := Find(PPage(P), Key, Index); + if Result then begin // Key found + if PPage(P)^.IsIndex then begin + P := PIndex(P)^.Index[Index].DataPage; + Index := 0; + end; + end else if PPage(P)^.IsIndex then + P := PData(PIndex(P)^.Index[Index].Child) + else + break; + until Result; + end; +end; + +function TheCmpBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean; +var Dummy: TValue; +begin + Result := Put(Key, Value, Dummy, CanOverwrite); +end; + +function TheCmpBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean; +var + P, Parent: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then + Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite) + else + Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite) + else if P^.IsIndex then begin + if P^.Count > 2 * KIndex then + SplitIndex(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child + end else begin + if P^.Count < 2 * KData then // page is not full + InsertItem(P, Index, Key, Value) + else // page is full + Overflow(Parent, P, ParentIndex, Index, Key, Value); + break; + end; + until Result + else begin // tree is empty + FRoot := InsertItem(Page(False), 0, Key, Value); + FFirst := Root; + FLast := Root; + end; +end; + +function TheCmpBTreeMap.Keys: TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey); +end; + +function TheCmpBTreeMap.KeysReversed: TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey); +end; + +function TheCmpBTreeMap.Values: TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); +end; + +function TheCmpBTreeMap.ValuesReversed: TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +procedure TheCmpBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); +var Right: PPage; +begin + Right := Page(False); + if PData(P)^.Next <> nil then begin // P was not last + PData(Right)^.Next := PData(P)^.Next; + PData(Right)^.Next^.Prev := PData(Right); + end else // P was last + FLast := Right; + PData(P)^.Next := PData(Right); + PData(Right)^.Prev := PData(P); + Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0])); + P^.Count := KData; + Right^.Count := KData; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, Right, Right) + else + FRoot := Insert(Page(True, P), 0, Right, Right); + if Index > KData then + InsertItem(Right, Index - KData, Key, Value) + else + InsertItem(P, Index, Key, Value); +end; + +procedure TheCmpBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Right: PPage; +begin + Right := Page(True); + Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer)); + P^.Count := KIndex; + Right^.Count := KIndex; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right) + else + FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right); + if Index > KIndex then begin + P := Right; + Index -= KIndex + 1; + end; +end; + +procedure TheCmpBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean); +begin + Prev := Dest; + if CanOverwrite then + Dest := Value; +end; + +procedure TheCmpBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then + MoveRight(Left, P) + else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then + MoveLeft(P, Right) + else if Left <> nil then + Concat(Parent, Left, P, ParentIndex - 1) + else + Concat(Parent, P, Right, ParentIndex); +end; + +procedure TheCmpBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count > KIndex) then begin + Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer)); + PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child; + PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage; + P^.Count += 1; + Index += 1; + Left^.Count -= 1; + PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage; + Exit; + end; + + if (Right <> nil) and (Right^.Count > KIndex) then begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + P^.Count += 1; + PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child; + PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage; + Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer)); + Right^.Count -= 1; + Exit; + end; + + if Left <> nil then begin + Index += Left^.Count + 1; + ConcatIndex(Parent, Left, P, ParentIndex - 1); + P := Left; + Exit; + end; + + ConcatIndex(Parent, P, Right, ParentIndex); +end; + +function TheCmpBTreeMap.MissingKeyValue(const Key: TKey): TValue; +begin + Assert(@Key = @Key); // hint off + Initialize(Result); // hint off + raise EMapKeyNotFound.Create(ClassName); +end; + +{ TheObjectBTreeMap } + +procedure TheObjectBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage); +begin + Left := nil; + Right := nil; + if ParentIndex >= 0 then begin + if ParentIndex > 0 then + Left := PIndex(Parent)^.Index[ParentIndex - 1].Child; + if ParentIndex < Parent^.Count then + Right := PIndex(Parent)^.Index[ParentIndex + 1].Child; + end; +end; + +procedure TheObjectBTreeMap.Clear; +begin + if Root <> nil then begin + Clear(Root); + FCount := 0; + FFirst := nil; + FLast := nil; + FRoot := nil; + end; +end; + +procedure TheObjectBTreeMap.Clear(const P: PPage); +var I: Integer; +begin + if P^.IsIndex then + for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn + Clear(PIndex(P)^.Index[I].Child) + else begin + for I := 0 to P^.Count - 1 do + Finalize(PData(P)^.Data[I].Key); + if OwnObjects then + for I := 0 to P^.Count - 1 do + PData(P)^.Data[I].Value.Free; + end; + FreeMem(P); +end; + +procedure TheObjectBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + MoveLeft(P, Right, Right^.Count); + if PData(Right)^.Next <> nil then + PData(Right)^.Next^.Prev := PData(P) + else + FLast := P; + PData(P)^.Next := PData(Right)^.Next; + FreeMem(Right); + if Parent^.Count > 1 then begin + ExtractIndex(Parent, ParentIndex); + PIndex(Parent)^.Index[ParentIndex].Child := P; + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +procedure TheObjectBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer); +begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer)); + P^.Count += Right^.Count + 1; + FreeMem(Right); + if Parent^.Count > 1 then begin + Parent^.Count -= 1; + if ParentIndex < Parent^.Count then + Move( + PIndex(Parent)^.Index[ParentIndex + 1].DataPage, + PIndex(Parent)^.Index[ParentIndex].DataPage, + 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer) + ); + end else begin + FreeMem(Root); + FRoot := P; + end; +end; + +constructor TheObjectBTreeMap.Create(const AOwnObjects: Boolean; const AKIndex: Integer; const AKData: Integer); +begin + inherited Create; + FOwnObjects := AOwnObjects; + FKIndex := Max(AKIndex, 2); + FKData := Max(AKData, 1); +end; + +function TheObjectBTreeMap.Delete(const Key: TKey): Boolean; +var Dummy: TValue; +begin + Result := Extract(Key, Dummy); +end; + +destructor TheObjectBTreeMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TheObjectBTreeMap.Compare(const A, B: TKey): Integer; +begin + Result := 0; // hint off + Assert(@A = @A); // hint off + Assert(@B = @B); // hint off + raise EAbstractError.Create(Format('%s.Compare', [ClassName])); +end; + +function TheObjectBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue; +begin + Result := PData(P)^.Data[Index].Value; + Finalize(PData(P)^.Data[Index].Key); + P^.Count -= 1; + if Index < P^.Count then + Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + FCount -=1; +end; + +procedure TheObjectBTreeMap.ExtractIndex(const P: PPage; const Index: Integer); +begin + P^.Count -= 1; + if Index < P^.Count then + Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer)); +end; + +function TheObjectBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean; +var + Parent, P, DataPage: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then begin + DataPage := PPage(PIndex(P)^.Index[Index].DataPage); + if DataPage^.Count > KData then + Value := ExtractData(DataPage, 0) + else begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index + 1; + Parent := P; + P := PIndex(P)^.Index[ParentIndex].Child; + Result := False; + end; + end else begin + Value := ExtractData(P, Index); + if P^.Count < KData then + if P <> Root then + Underflow(Parent, P, ParentIndex) + else if Count = 0 then + Clear; + end + else if P^.IsIndex then begin + if (P^.Count < KIndex) and (P <> Root) then + Underflow(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child; + end else + break; // give up + until Result +end; + +function TheObjectBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean; +type PKey = ^TKey; +var + L, H, Cmp: Integer; + MidKey: PKey; + Mid: Integer absolute Index; +begin + L := 0; + H := P^.Count - 1; + while L <= H do begin + Mid := (L + H) shr 1; + if P^.IsIndex then + MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key + else + MidKey := @PData(P)^.Data[Mid].Key; + Cmp := Compare(Key, Midkey^); + if Cmp > 0 then + L := Mid + 1 + else if Cmp = 0 then + Exit(True) + else + H := Mid - 1; + end; + Index := L; + Result := False; +end; + +function TheObjectBTreeMap.GetCurrent(var Iterator: TIterator): TValue; +begin + Result := Iterator.Page^.Data[Iterator.Index].Value; +end; + +function TheObjectBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey; +begin + Result := Iterator.Page^.Data[Iterator.Index].Key; +end; + +function TheObjectBTreeMap.GetFirst: TValue; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0].Value; +end; + +function TheObjectBTreeMap.GetFirstKey: TKey; +begin + Assert(Count <> 0); + Result := PData(FFirst)^.Data[0].Key; +end; + +function TheObjectBTreeMap.GetLast: TValue; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1].Value; +end; + +function TheObjectBTreeMap.GetLastKey: TKey; +begin + Assert(Count <> 0); + Result := PData(FLast)^.Data[FLast^.Count - 1].Key; +end; + +function TheObjectBTreeMap.GetMap(const Key: TKey): TValue; +begin + if not Get(Key, Result) then + Result := MissingKeyValue(Key); +end; + +function TheObjectBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if Compare(RangeFrom, RangeTo) <= 0 then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +function TheObjectBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.UseSentinel := True; + Iterator.Sentinel := RangeTo; + + if Compare(RangeFrom, RangeTo) <= 0 then begin + Seek(RangeFrom, Iterator.Page, Iterator.Index); + Dec(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey); + Exit; + end; + + // RangeFrom > RangeTo + if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then + Inc(Iterator.Index); + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey); +end; + +function TheObjectBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean; +var + P: PPage; + Index: Integer; +begin + Result := False; + P := Root; + if P <> nil then // tree is non empty + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then + Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value + else + Value := PData(P)^.Data[Index].Value + else if P^.IsIndex then + P := PIndex(P)^.Index[Index].Child + else + break; // give up + until Result; +end; + +function TheObjectBTreeMap.Insert(const P: PPage; const Index: Integer): PPage; +begin + if Index < P^.Count then + if P^.IsIndex then + Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer)) + else + Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0])); + Inc(P^.Count); + Result := P; +end; + +function TheObjectBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage; +begin + Result := Insert(P, Index); + PIndex(Result)^.Index[Index].DataPage := PData(DataPage); + PIndex(Result)^.Index[Index + 1].Child := Child; +end; + +function TheObjectBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage; +begin + Result := Insert(P, Index); + Initialize(PData(P)^.Data[Index].Key); + PData(P)^.Data[Index].Key := Key; + PData(P)^.Data[Index].Value := Value; + Inc(FCount); +end; + +procedure TheObjectBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer); +begin + Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0])); + Left^.Count += N; + P^.Count -= N; +end; + +function TheObjectBTreeMap.MoveNext(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Inc(Iterator.Index); + if Iterator.Index < PPage(Iterator.Page)^.Count then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) <= 0)); + Iterator.Page := Iterator.Page^.Next; + Iterator.Index := -1; + end; + Result := False; +end; + +function TheObjectBTreeMap.MovePrev(var Iterator: TIterator): Boolean; +begin + while Iterator.Page <> nil do begin + Dec(Iterator.Index); + if Iterator.Index >= 0 then + Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) >= 0)); + Iterator.Page := Iterator.Page^.Prev; + if Iterator.Page <> nil then + Iterator.Index := PPage(Iterator.Page)^.Count; + end; + Result := False; +end; + +procedure TheObjectBTreeMap.MoveRight(const P, Right: PPage; const N: Integer); +begin + Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0])); + Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0])); + Right^.Count += N; + P^.Count -= N; +end; + +procedure TheObjectBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count < 2 * KData) then begin + MoveLeft(Left, P); + InsertItem(P, Index - 1, Key, Value); + Exit; + end; + + if (Right <> nil) and (Right^.Count < 2 * KData) then begin + if Index < 2 * KData then begin + MoveRight(P, Right); + InsertItem(P, Index, Key, Value) + end else + InsertItem(Right, 0, Key, Value); + Exit; + end; + + SplitData(Parent, P, ParentIndex, Index, Key, Value); +end; + +procedure TheObjectBTreeMap.SetMap(const Key: TKey; const Value: TValue); +begin + Put(Key, Value); +end; + +function TheObjectBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage; +begin + if IsIndex then begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer)); + PIndex(Result)^.Index[0].Child := LeftmostChild; + end else begin + GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0])); + PData(Result)^.Prev := nil; + PData(Result)^.Next := nil; + end; + Result^.IsIndex := IsIndex; + Result^.Count := 0; +end; + +function TheObjectBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean; +begin + Result := False; + P := PData(Root); + if P <> nil then begin // tree is non empty + repeat + Result := Find(PPage(P), Key, Index); + if Result then begin // Key found + if PPage(P)^.IsIndex then begin + P := PIndex(P)^.Index[Index].DataPage; + Index := 0; + end; + end else if PPage(P)^.IsIndex then + P := PData(PIndex(P)^.Index[Index].Child) + else + break; + until Result; + end; +end; + +function TheObjectBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean; +var Dummy: TValue; +begin + Result := Put(Key, Value, Dummy, CanOverwrite); +end; + +function TheObjectBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean; +var + P, Parent: PPage; + Index, ParentIndex: Integer; +begin + Result := False; + ParentIndex := -1; + Parent := nil; + P := Root; + if P <> nil then + repeat + Result := Find(P, Key, Index); + if Result then // Key found + if P^.IsIndex then + Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite) + else + Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite) + else if P^.IsIndex then begin + if P^.Count > 2 * KIndex then + SplitIndex(Parent, P, ParentIndex, Index); + ParentIndex := Index; + Parent := P; + P := PIndex(P)^.Index[Index].Child + end else begin + if P^.Count < 2 * KData then // page is not full + InsertItem(P, Index, Key, Value) + else // page is full + Overflow(Parent, P, ParentIndex, Index, Key, Value); + break; + end; + until Result + else begin // tree is empty + FRoot := InsertItem(Page(False), 0, Key, Value); + FFirst := Root; + FLast := Root; + end; +end; + +function TheObjectBTreeMap.Keys: TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey); +end; + +function TheObjectBTreeMap.KeysReversed: TKeyEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey); +end; + +function TheObjectBTreeMap.Values: TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FFirst); + Iterator.Index := -1; + Iterator.UseSentinel := False; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent); +end; + +function TheObjectBTreeMap.ValuesReversed: TValueEnumeratorProvider; +var Iterator: TIterator; +begin + Iterator.Page := PData(FLast); + Iterator.UseSentinel := False; + if FLast <> nil then + Iterator.Index := FLast^.Count; + Assert(Iterator.Page = Iterator.Page); // hint off + Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent); +end; + +procedure TheObjectBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue); +var Right: PPage; +begin + Right := Page(False); + if PData(P)^.Next <> nil then begin // P was not last + PData(Right)^.Next := PData(P)^.Next; + PData(Right)^.Next^.Prev := PData(Right); + end else // P was last + FLast := Right; + PData(P)^.Next := PData(Right); + PData(Right)^.Prev := PData(P); + Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0])); + P^.Count := KData; + Right^.Count := KData; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, Right, Right) + else + FRoot := Insert(Page(True, P), 0, Right, Right); + if Index > KData then + InsertItem(Right, Index - KData, Key, Value) + else + InsertItem(P, Index, Key, Value); +end; + +procedure TheObjectBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Right: PPage; +begin + Right := Page(True); + Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer)); + P^.Count := KIndex; + Right^.Count := KIndex; + if ParentIndex >= 0 then + Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right) + else + FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right); + if Index > KIndex then begin + P := Right; + Index -= KIndex + 1; + end; +end; + +procedure TheObjectBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean); +begin + Prev := Dest; + if CanOverwrite then + Dest := Value; +end; + +procedure TheObjectBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then + MoveRight(Left, P) + else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then + MoveLeft(P, Right) + else if Left <> nil then + Concat(Parent, Left, P, ParentIndex - 1) + else + Concat(Parent, P, Right, ParentIndex); +end; + +procedure TheObjectBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer); +var Left, Right: PPage; +begin + CheckSiblings(Parent, ParentIndex, Left, Right); + + if (Left <> nil) and (Left^.Count > KIndex) then begin + Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer)); + PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child; + PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage; + P^.Count += 1; + Index += 1; + Left^.Count -= 1; + PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage; + Exit; + end; + + if (Right <> nil) and (Right^.Count > KIndex) then begin + PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage; + P^.Count += 1; + PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child; + PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage; + Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer)); + Right^.Count -= 1; + Exit; + end; + + if Left <> nil then begin + Index += Left^.Count + 1; + ConcatIndex(Parent, Left, P, ParentIndex - 1); + P := Left; + Exit; + end; + + ConcatIndex(Parent, P, Right, ParentIndex); +end; + +function TheObjectBTreeMap.MissingKeyValue(const Key: TKey): TValue; +begin + Assert(@Key = @Key); // hint off + Initialize(Result); // hint off + raise EMapKeyNotFound.Create(ClassName); +end; + +end. +