7371 lines
211 KiB
Plaintext
7371 lines
211 KiB
Plaintext
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<TIterator, TValue> = 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<TProvidedEnumerator> = object
|
|
public
|
|
FEnumerator: TProvidedEnumerator;
|
|
function GetEnumerator: TProvidedEnumerator;
|
|
end;
|
|
|
|
{ TheObjectVector }
|
|
|
|
generic TheObjectVector<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectVector }
|
|
public type
|
|
PItem = ^TItem;
|
|
TCompare = function(const A, B: TItem): Integer;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheVector }
|
|
public type
|
|
PItem = ^TItem;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheCmpVector }
|
|
public type
|
|
PItem = ^TItem;
|
|
TCompare = function(const A, B: TItem): Integer;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheSortVector }
|
|
public type
|
|
PItem = ^TItem;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheVectorSet }
|
|
public type
|
|
PItem = ^TItem;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheVectorMap }
|
|
public type
|
|
PItem = ^TItem;
|
|
TItem = record
|
|
Key: TKey;
|
|
Value: TValue;
|
|
end;
|
|
TKeyEnumerator = specialize TheEnumerator<Integer, TKey>;
|
|
TValueEnumerator = specialize TheEnumerator<Integer, TValue>;
|
|
TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
|
|
TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
|
|
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<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheCmpVectorMap }
|
|
public type
|
|
PItem = ^TItem;
|
|
TItem = record
|
|
Key: TKey;
|
|
Value: TValue;
|
|
end;
|
|
TKeyEnumerator = specialize TheEnumerator<Integer, TKey>;
|
|
TValueEnumerator = specialize TheEnumerator<Integer, TValue>;
|
|
TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
|
|
TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
|
|
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<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheObjectVectorMap }
|
|
public type
|
|
PItem = ^TItem;
|
|
TItem = record
|
|
Key: TKey;
|
|
Value: TValue;
|
|
end;
|
|
TKeyEnumerator = specialize TheEnumerator<Integer, TKey>;
|
|
TValueEnumerator = specialize TheEnumerator<Integer, TValue>;
|
|
TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
|
|
TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheCmpVectorSet }
|
|
public type
|
|
PItem = ^TItem;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectVectorSet }
|
|
public type
|
|
PItem = ^TItem;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheCmpSortVector }
|
|
public type
|
|
PItem = ^TItem;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectSortVector }
|
|
public type
|
|
PItem = ^TItem;
|
|
TEnumerator = specialize TheEnumerator<Integer, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = 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<TIterator, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = 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<TIterator, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = 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<TIterator, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = 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<TIterator, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TItem> = 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<TIterator, TItem>;
|
|
TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
|
|
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<TKey, TValue> = 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<TIterator, TKey>;
|
|
TValueEnumerator = specialize TheEnumerator<TIterator, TValue>;
|
|
TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
|
|
TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
|
|
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<TKey, TValue> = 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<TIterator, TKey>;
|
|
TValueEnumerator = specialize TheEnumerator<TIterator, TValue>;
|
|
TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
|
|
TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
|
|
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<TKey, TValue> = 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<TIterator, TKey>;
|
|
TValueEnumerator = specialize TheEnumerator<TIterator, TValue>;
|
|
TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
|
|
TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
|
|
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.
|
|
|