Курсовой проект групп 3341 и 3382 / DMCore / utils / uContainers

// Классы и коллекции для организации //
// обычных списков, хэш таблиц //

unit uContainers;

interface

uses Registry, uBinary, uConsts, uAlgorithm;

type
{ Класс TArrayList - список элементов типа Pointer или TObject }

TGroupEnumerator = class;

TArrayList = class(TObject)
private
FCapacity: Integer;
FItems: PPointerItemList;
FCount: Integer;
FOwnItems: Boolean;
procedure SetCapacity(NewCapacity: Integer);
public

{ Конструктор Create создает экземпляр класса TArrayList и выделяет память
под InitialCapacity элементов во внутреннем массиве. }

constructor Create(InitialCapacity: Integer = 0);

{ Деструктор Destroy освобождает память, занятую экземпляром класса
TArrayList и его внутренним массивом. Если свойство OwnItems равно True,
каждый элемент списка приводится к типу TObject и для него вызывается
метод Free. }

destructor Destroy; override;

{ Свойства }

{ Свойство Count возвращает или устанавливает текущее число элементов
в списке. При присвоении значения данному свойству никаких проверок
не выполняется. }

property Count: Integer read FCount write FCount;

{ Свойство ItemList возвращает указатель на внутренний массив, используемый
для хранения элементов списка. Этот указатель меняется при изменении
свойства Capacity. Обращение к свойству ItemList является основным методом
доступа к элементам списка. }

property ItemList: PPointerItemList read FItems;

{ Свойство Capacity считывает или изменяет количество элементов, под которое
распределена память во внутреннем массиве. Если при добавлении нового
элемента фактическое число элементов превысит Capacity, произойдет
перераспределение памяти и свойство Capacity увеличится до значения,
рассчитанного вызовом G_EnlargeCapacity(Capacity). }

property Capacity: Integer read FCapacity write SetCapacity;

{ Если свойство OwnItems равно True, при удалении элементов и полной очистке
списка, например из деструктора класса, для каждого элемента вызывается
метод Free, чтобы освободить память, занимаемую соответствующим объектом.
По умолчанию это свойство равно False и метод Free не вызывается для
элементов списка. }

property OwnItems: Boolean read FOwnItems write FOwnItems;

{ Методы }

{ Следующий метод Load загружает элементы из другого экземпляра списка,
переданного параметром ArrayList. Перед загрузкой данных вызывается метод
Clear с параметром SuppressDisposingItems. }

procedure Load(ArrayList: TArrayList;
SuppressDisposingItems: Boolean = False); overload;

{ Следующий метод Load загружает список из массива указателей, адресуемого
параметром Items, состоящего из Count элементов. Перед загрузкой данных
вызывается метод Clear с параметром SuppressDisposingItems. }

procedure Load(Items: Pointer; Count: Integer;
SuppressDisposingItems: Boolean = False); overload;

{ Вызов метода EnsureCapacity гарантирует, что размер внутреннего массива,
адресуемого свойством ItemList, будет достаточен для хранения Capacity
элементов, т.е. свойство Capacity данного экземпляра класса TArrayList
будет больше или равно значению, переданному параметром Capacity. }

procedure EnsureCapacity(Capacity: Integer);

{ Метод Add добавляет значение, переданное параметром P, в конец списка. }

procedure Add(P: Pointer);

{ Следующий метод Insert вставляет значение, переданное параметром P,
в позицию Index списка (индексация с нуля). }

procedure Insert(Index: Integer; P: Pointer); overload;

{ Следующий метод Insert вставляет в позицию Index списка (индексация с нуля)
массив из Count указателей, адресуемый параметром Items. }

procedure Insert(Index: Integer; Items: Pointer; Count: Integer); overload;

{ Следующий метод Insert вставляет Count копий значения, переданного
параметром P, в позицию Index списка (индексация с нуля). }

procedure Insert(Index, Count: Integer; P: Pointer); overload;

{ Функция PopBack возвращает указатель на последний элемент списка и
уменьшает число элементов на единицу. Эта операция подобна извлечению
элемента из стека. Поместить элемент в стек можно методом Add. }

function PopBack: Pointer;

{ Функция PeekBack возвращает указатель на последний элемент списка, т.е.
элемент с индексом (Count - 1). }

function PeekBack: Pointer;

{ Функция ScanPointer выполняет последовательный поиск элемента списка,
указатель на который передан параметром P, и возвращает индекс найденного
элемента. Если в списке нет элемента с таким указателем, возвращает
значение -1. Если список большой и он отсортирован по возрастанию, лучше
использовать функцию IndexOf, реализующую бинарный поиск. }

function ScanPointer(P: Pointer): Integer;

{ Метод Sort сортирует элементы списка в порядке возрастания. Функция для
сравнения элементов задается параметром CompareFunction. }

procedure Sort(CompareFunction: TCompareFunction);

{ Метод StableSort сортирует элементы списка в порядке возрастания.
В отличие от метода Sort, относительное расположение равных элементов
списка не меняется, но функция сортировки использует дополнительную память.
Функция для сравнения элементов задается параметром CompareFunction. }

procedure StableSort(CompareFunction: TCompareFunction);

{ Функция EnumerateGroups сортирует и группирует элементы списка. Они
сравниваются между собой с помощью функции, которая передается параметром
CompareFunction. В группу объединяются элементы, которые равны с точки
зрения функции CompareFunction. Если данный список уже отсортирован
по возрастанию, в параметре Sorted следует передать значение True,
чтобы избежать повторной сортировки. Иначе, в параметре Sorted надо
передавать False. Функция EnumerateGroups возвращает экземпляр класса
TGroupEnumerator, представляющий собой коллекцию групп. }

function EnumerateGroups(CompareFunction: TCompareFunction;
Sorted: Boolean = False): TGroupEnumerator;

{ Функция Search выполняет бинарный или линейный поиск значения Value
в списке. Если список отсортирован по возрастанию значения искомого
признака, в параметре Sorted следует передать значение True. В этом случае
используется метод бинарного поиска. Если в параметр Sorted равен False,
применяется линейный поиск. Искомое значение передается в виде указателя.
Функция для сопоставления значения элементу списка передается параметром
MatchFunction. В случае успеха функция Search возвращает указатель
на искомый элемент списка, иначе возвращает nil. }

function Search(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean = False): Pointer;

{ Функция IndexOf выполняет бинарный или линейный поиск значения Value
в списке. Если список отсортирован по возрастанию значения искомого
признака, в параметре Sorted следует передать значение True. В этом случае
используется метод бинарного поиска. Если в параметр Sorted равен False,
применяется линейный поиск. Искомое значение передается в виде указателя.
Функция для сопоставления значения элементу списка передается параметром
MatchFunction. В случае успеха функция IndexOf возвращает индекс искомого
элемента списка, иначе возвращает -1. }

function IndexOf(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean = False): Integer;

{ Следующий метод RemoveAt удаляет из списка элемент, находящийся в позиции
Index (индексация с нуля). Если свойство OwnItems равно True, элемент
приводится к типу TObject и для него вызывается метод Free. }

procedure RemoveAt(Index: Integer); overload;

{ Следующий метод RemoveAt удаляет из списка Count последовательных
элементов, начиная с элемента с индексом Index. Если свойство OwnItems
равно True, каждый удаляемый элемент приводится к типу TObject и для
него вызывается метод Free. }

procedure RemoveAt(Index, Count: Integer); overload;

{ Метод UnorderedRemoveAt удаляет из списка элемент, находящийся в позиции
Index (индексация с нуля). Удаляемый элемент замещается последним элементом
списка, после чего свойство Count уменьшается на 1. Метод выполняется
значительно быстрее, чем RemoveAt, но приводит к изменению относительного
порядка элементов списка. Если свойство OwnItems равно True, удаляемый
элемент приводится к типу TObject и для него вызывается метод Free. }

procedure UnorderedRemoveAt(Index: Integer);

{ Метод Clear очищает список без освобождения памяти, занимаемой внутренним
массивом. Если свойство OwnItems равно True, каждый элемент списка
приводится к типу TObject и для него вызывается метод Free. Однако, если
в параметре SuppressDisposingItems передано значение True, метод Free
для элементов списка не вызывается. }

procedure Clear(SuppressDisposingItems: Boolean = False);

{ Метод TrimToSize изменяет размер внутреннего массива, адресуемого свойством
ItemList, таким образом, чтобы он соответствовал занятому в настоящий
момент количеству элементов. }

procedure TrimToSize;

{ Функция Equals возвращает True, если данный список поэлементно равен списку
ArrayList. Если списки содержат различное число элементов или содержат
неравные соответствующие элементы, функция возвращает False. Равенство
элементов проверяется с помощью функции CompareFunction, а если она
не указана, сравниваются указатели на соответствующие элементы списков. }

function Equals(ArrayList: TArrayList;
CompareFunction: TCompareFunction = nil): Boolean;

{ Функция Clone возвращает экземпляр класса TArrayList, который является
копией данного списка. Свойство OwnItems нового списка равно False. }

function Clone: TArrayList;
end;


{ Класс TArrayReadOnlyList представляет собой список элементов типа Pointer,
аналогичный TArrayList, но не допускающий добавления/удаления элементов. }

TArrayReadOnlyList = class(TObject)
private
FItems: PPointerItemList;
FCount: Integer;
public

{ Конструктор Create создает экземпляр класса TArrayReadOnlyList на основе
массива указателей, адресуемого параметром ItemList, длиной Count элементов. }

constructor Create(ItemList: PPointerItemList; Count: Integer);

{ Свойства }

{ Свойство Count возвращает число элементов в списке. }

property Count: Integer read FCount;

{ Свойство ItemList возвращает указатель на внутренний массив, содержащий
элементы списка. Обращение к свойству ItemList является основным методом
доступа к элементам списка. }

property ItemList: PPointerItemList read FItems;

{ Методы }

{ Функция ScanPointer выполняет последовательный поиск элемента списка,
указатель на который передан параметром P, и возвращает индекс найденного
элемента. Если в списке нет элемента с таким указателем, возвращает
значение -1. Если список большой и он отсортирован по возрастанию, лучше
использовать функцию IndexOf, реализующую бинарный поиск. }

function ScanPointer(P: Pointer): Integer;

{ Метод Sort сортирует элементы списка в порядке возрастания. Функция для
сравнения элементов задается параметром CompareFunction. }

procedure Sort(CompareFunction: TCompareFunction);

{ Метод StableSort сортирует элементы списка в порядке возрастания.
В отличие от метода Sort, относительное расположение равных элементов
списка не меняется, но функция сортировки использует дополнительную память.
Функция для сравнения элементов задается параметром CompareFunction. }

procedure StableSort(CompareFunction: TCompareFunction);

{ Функция EnumerateGroups сортирует и группирует элементы списка. Они
сравниваются между собой с помощью функции, которая передается параметром
CompareFunction. В группу объединяются элементы, которые равны с точки
зрения функции CompareFunction. Если данный список уже отсортирован
по возрастанию, в параметре Sorted следует передать значение True,
чтобы избежать повторной сортировки. Иначе, в параметре Sorted надо
передавать False. Функция EnumerateGroups возвращает экземпляр класса
TGroupEnumerator, представляющий собой коллекцию групп. }

function EnumerateGroups(CompareFunction: TCompareFunction;
Sorted: Boolean = False): TGroupEnumerator;

{ Функция Search выполняет бинарный или линейный поиск значения Value
в списке. Если список отсортирован по возрастанию значения искомого
признака, в параметре Sorted следует передать значение True. В этом случае
используется метод бинарного поиска. Если в параметр Sorted равен False,
применяется линейный поиск. Искомое значение передается в виде указателя.
Функция для сопоставления значения элементу списка передается параметром
MatchFunction. В случае успеха функция Search возвращает указатель
на искомый элемент списка, иначе возвращает nil. }

function Search(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean = False): Pointer;

{ Функция IndexOf выполняет бинарный или линейный поиск значения Value
в списке. Если список отсортирован по возрастанию значения искомого
признака, в параметре Sorted следует передать значение True. В этом случае
используется метод бинарного поиска. Если в параметр Sorted равен False,
применяется линейный поиск. Искомое значение передается в виде указателя.
Функция для сопоставления значения элементу списка передается параметром
MatchFunction. В случае успеха функция IndexOf возвращает индекс искомого
элемента списка, иначе возвращает -1. }

function IndexOf(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean = False): Integer;

{ Функция Equals возвращает True, если данный список поэлементно равен списку
ArrayList. Если списки содержат различное число элементов или содержат
неравные соответствующие элементы, функция возвращает False. Равенство
элементов проверяется с помощью функции CompareFunction, а если она
не указана, сравниваются указатели на соответствующие элементы списков. }

function Equals(ArrayList: TArrayReadOnlyList;
CompareFunction: TCompareFunction = nil): Boolean; overload;
function Equals(ArrayList: TArrayList;
CompareFunction: TCompareFunction = nil): Boolean; overload;

{ Функция Clone возвращает экземпляр класса TArrayList, который является
копией данного списка. Свойство OwnItems нового списка равно False. }

function Clone: TArrayList;
end;


{ Класс TGroupEnumerator - сгруппированный набор данных }

{ Тип массива и указателя на массив групп, каждая из которых представляет
собой коллекцию типа TArrayReadOnlyList. }

PGroupList = ^TGroupList;
TGroupList = array[0..DWordListUpperLimit] of TArrayReadOnlyList;

TGroupEnumerator = class(TObject)
private
FGroups: PGroupList;
FGroupCount: Integer;
public

{ Конструктор Create создает экземпляр класса TGroupEnumerator, который
представляет собой коллекцию групп. Сортирует и группирует элементы
массива ссылок, адресуемого параметром ItemList, состоящего из Count
элементов. При сортировке элементы массива попарно сравниваются с помощью
функции CompareFunction. В группу затем объединяются элементы, равные
с точки зрения этой функции. }

constructor Create(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction; Sorted: Boolean);

{ Деструктор Destroy освобождает память, занятую экземпляром класса
TGroupEnumerator и его внутренним массивом, содержащим группы элементов.
При этом для каждой группы (экземпляра класса TArrayReadOnlyList)
вызывается метод Free. }

destructor Destroy; override;

{ Свойства }

{ Свойство GroupCount возвращает число групп в наборе. }

property GroupCount: Integer read FGroupCount;

{ Свойство GroupList возвращает указатель на внутренний массив, содержащий
группы элементов. Обращение к свойству GroupList является основным методом
доступа к группам. }

property GroupList: PGroupList read FGroups;
end;

{ Класс TStringHashtable представляет собой ассоциативный массив, где с каждым
ключом типа String связано значение типа Pointer или TObject. Ключи являются
уникальными и хранятся в виде хэшированного списка. }

TStringHashtable = class(TObject)
private
FCapacity: Integer;
FKeys: PStringItemList;
FValues: PPointerItemList;
FCount: Integer;
FMaxCount: Integer;
FCaseSensitive: Boolean;
FOwnValues: Boolean;
procedure SetMaxCount(NewMaxCount: Integer);
function GetIndex(P: Pointer): Integer;
procedure SetCapacity(NewCapacity: Integer);
function GetItem(const Key: string): Pointer;
procedure SetItem(const Key: string; Value: Pointer);
public

{ Конструктор Create создает экземпляр класса TStringHashtable и выделяет
память, достаточную для хранения InitialCapacity элементов во внутренних
массивах ключей и ассоциированных с ними значений. Параметр CaseSensitive
определяет, нужно ли учитывать регистр символов при сортировке и поиске
ключей типа String. Если этот параметр равен False, большие и маленькие
буквы в значении ключей не различаются, если True, они различаются. }

constructor Create(CaseSensitive: Boolean; InitialCapacity: Integer = 0);

{ Деструктор Destroy освобождает память, занятую внутренними массивами
и самим экземпляром класса TStringHashtable. Если свойство OwnValues
равно True, деструктор приводит каждое значение в ассоциативном списке
к типу TObject и вызывает для него метод Free }

destructor Destroy; override;

{ Свойства }

{ Свойство Count возвращает текущее число элементов в ассоциативном массиве. }

property Count: Integer read FCount;

{ Свойство Items считывает или устанавливает значение, ассоциированное
с ключом Key. При чтении, если такой ключ отсутствует в списке, свойство
возвращает nil. При записи, если такой ключ отсутствует, в список
добавляется пара ключ-значение. Если в списке уже есть значение,
соответствующее такому ключу, оно заменяется новым значением. При этом,
если свойство OwnValues равно True, старое значение приводится к типу
TObject и для него вызывается метод Free. }

property Items[const Key: string]: Pointer read GetItem write SetItem; default;

{ Свойство Capacity считывает или изменяет количество элементов, под которое
распределена память во внутренних массивах. Если при добавлении нового
элемента фактическое число элементов превысит Capacity, произойдет
выделение дополнительной памяти под внутренние массивы, что повлечет за
собой перестройку хэшированного списка ключей. }

property Capacity: Integer read FMaxCount write SetMaxCount;

{ Свойство CaseSensitive возвращает значение одноименного параметра,
переданного в конструктор данного класса. Если это значение равно True,
сравнение ключей типа String выполняется с учетом регистра символов,
если False, регистр символов игнорируется в значении ключей. }

property CaseSensitive: Boolean read FCaseSensitive;

{ Значение свойства OwnValues определяет, нужно ли вызывать метод Free
для значений, помещенных в ассоциативный список, когда они удаляются
из списка, заменяются новыми значениями или когда сам список выгружается
из памяти. По умолчанию свойство OwnValues равно False и метод Free
не вызывается. }

property OwnValues: Boolean read FOwnValues write FOwnValues;

{ Свойство InnerKeyList возвращает указатель на внутренний массив,
используемый для хранения ключей в виде хэшированного списка. Число
элементов в этом массиве определяется свойством InnerCapacity. Кроме
элементов, содержащих значения ключей, в этом списке встречаются пустые
элементы, равные nil, а также удаленные элементы. Числовое значение ключа
удаленного элемента хэша, т.е. PLongWord(@InnerKeyList^[I])^, равно
$FFFFFFFF. }

property InnerKeyList: PStringItemList read FKeys;

{ Свойство InnerValueList возвращает указатель на внутренний массив значений,
ассоциированных с ключами. Этот указатель меняется при изменении свойства
InnerCapacity. }

property InnerValueList: PPointerItemList read FValues;

{ Свойство InnerCapacity возвращает число элементов, под которое распределена
память в массивах InnerKeyList и InnerValueList. Значение этого свойства
составляет приблизительно 7/5 от значения свойства Capacity, т.к. для
эффективного выполнения поиска в хэшированном списке в нем должно быть
заполнено не более 71-73% элементов. }

property InnerCapacity: Integer read FCapacity;

{ Методы }

{ Вызов метода EnsureCapacity гарантирует, что размер внутренних массивов,
достаточен для помещения в список Capacity элементов, т.е. свойство
Capacity данного экземпляра класса TStringHashtable после вызова метода
EnsureCapacity будет больше или равно значению, переданному параметром
Capacity. }

procedure EnsureCapacity(Capacity: Integer);

{ Метод Add добавляет в ассоциативный список ключ Key и соответствующее
ему значение Value. Если в списке уже есть элемент с таким ключом,
возникает исключение. }

procedure Add(const Key: string; Value: Pointer);

{ Функция Contains возвращает True, если в хэшированном списке присутствует
ключ со значением Key. Если ключ с таким значением отсутствует в списке,
функция возвращает False. }

function Contains(const Key: string): Boolean;

{ Метод Remove удаляет из ассоциативного списка элемент с ключом Key, если
такой элемент имеется. Если свойство OwnValues равно True, значение,
ассоциированное с этим ключом, приводится к типу TObject и для него
вызывается метод Free. }

procedure Remove(const Key: string);

{ Метод Clear очищает массив InnerKeyList и устанавливает в ноль свойство
Count. Память, занятая под внутренние массивы, не освобождается и значение
свойства Capacity не меняется. Если свойство OwnValues равно True, каждое
значение в ассоциативном списке приводится к типу TObject и для него
вызывается метод Free. Однако, если в параметре SuppressDisposingValues
передано значение True, метод Free для значений в ассоциативном списке
не вызывается. }

procedure Clear(SuppressDisposingValues: Boolean = False);
end;

{ Специальные константы, используемые хэшами и бинарными деревьями }

{ Значения ключей для удаленных и пустых значений хэшированных списков
TIntegerHashtable и TStringHashtable. }

const
MissingIntegerHashKey = Integer($81000000);
EmptyIntegerHashKey = Integer($81000001);
MissingStringHashKey = Pointer($FFFFFFFF);

implementation

uses Windows, uCommon, uStrings;

{ TArrayList }

constructor TArrayList.Create(InitialCapacity: Integer);
begin
FCapacity := InitialCapacity;
if InitialCapacity > 0 then
GetMem(FItems, InitialCapacity * SizeOf(Pointer));
end;

destructor TArrayList.Destroy;
var
I: Integer;
begin
if FCapacity > 0 then
begin
if FOwnItems then
for I := FCount - 1 downto 0 do
TObject(FItems^[I]).Free;
FreeMem(FItems);
end;
end;

procedure TArrayList.SetCapacity(NewCapacity: Integer);
var
NewItems: PPointerItemList;
begin
if (NewCapacity <> FCapacity) and (NewCapacity >= FCount) then
begin
if NewCapacity > 0 then
begin
GetMem(NewItems, NewCapacity * SizeOf(Pointer));
if FCount > 0 then
G_CopyLongs(FItems, NewItems, FCount);
end else
NewItems := nil;
if FCapacity > 0 then
FreeMem(FItems);
FCapacity := NewCapacity;
FItems := NewItems;
end;
end;

procedure TArrayList.Load(ArrayList: TArrayList; SuppressDisposingItems: Boolean);
var
C: Integer;
begin
Clear(SuppressDisposingItems);
C := ArrayList.FCount;
if C > FCapacity then
SetCapacity(G_NormalizeCapacity(C));
if C > 0 then
G_CopyLongs(ArrayList.FItems, FItems, C);
FCount := C;
end;

procedure TArrayList.Load(Items: Pointer; Count: Integer;
SuppressDisposingItems: Boolean);
begin
Clear(SuppressDisposingItems);
if Count > FCapacity then
SetCapacity(G_NormalizeCapacity(Count));
if Count > 0 then
G_CopyLongs(Items, FItems, Count);
FCount := Count;
end;

procedure TArrayList.EnsureCapacity(Capacity: Integer);
begin
if FCapacity < Capacity then
SetCapacity(G_NormalizeCapacity(Capacity));
end;

procedure TArrayList.Add(P: Pointer);
begin
if FCount >= FCapacity then
SetCapacity(G_EnlargeCapacity(FCapacity));
FItems^[FCount] := P;
Inc(FCount);
end;

procedure TArrayList.Insert(Index: Integer; P: Pointer);
begin
if LongWord(Index) > LongWord(FCount) then
RaiseError(SErrIndexOutOfRange);
if FCount >= FCapacity then
SetCapacity(G_EnlargeCapacity(FCapacity));
if Index < FCount then
G_MoveLongs(@FItems^[Index], @FItems^[Index + 1], FCount - Index);
FItems^[Index] := P;
Inc(FCount);
end;

procedure TArrayList.Insert(Index: Integer; Items: Pointer; Count: Integer);
var
C: Integer;
begin
if LongWord(Index) > LongWord(FCount) then
RaiseError(SErrIndexOutOfRange);
if Count <= 0 then
Exit;
if Count + FCount > FCapacity then
begin
C := G_EnlargeCapacity(FCapacity);
if C < Count + FCount then
C := Count + FCount;
SetCapacity(C);
end;
if Index < FCount then
G_MoveLongs(@FItems^[Index], @FItems^[Index + Count], FCount - Index);
G_CopyLongs(Items, @FItems^[Index], Count);
Inc(FCount, Count);
end;

procedure TArrayList.Insert(Index, Count: Integer; P: Pointer);
var
C: Integer;
begin
if LongWord(Index) > LongWord(FCount) then
RaiseError(SErrIndexOutOfRange);
if Count <= 0 then
Exit;
if Count + FCount > FCapacity then
begin
C := G_EnlargeCapacity(FCapacity);
if C < Count + FCount then
C := Count + FCount;
SetCapacity(C);
end;
if Index < FCount then
G_MoveLongs(@FItems^[Index], @FItems^[Index + Count], FCount - Index);
G_FillLongs(LongWord(P), @FItems^[Index], Count);
Inc(FCount, Count);
end;

function TArrayList.PopBack: Pointer;
begin
if FCount = 0 then
RaiseError(SErrPeekFromEmptyList);
Dec(FCount);
Result := FItems^[FCount];
end;

function TArrayList.PeekBack: Pointer;
begin
if FCount = 0 then
RaiseError(SErrPeekFromEmptyList);
Result := FItems^[FCount - 1];
end;

function TArrayList.ScanPointer(P: Pointer): Integer;
begin
Result := G_Scan_Pointer(P, FItems, FCount);
end;

procedure TArrayList.Sort(CompareFunction: TCompareFunction);
begin
G_Sort(FItems, FCount, CompareFunction);
end;

procedure TArrayList.StableSort(CompareFunction: TCompareFunction);
begin
G_StableSort(FItems, FCount, CompareFunction);
end;

function TArrayList.EnumerateGroups(CompareFunction: TCompareFunction;
Sorted: Boolean): TGroupEnumerator;
begin
Result := TGroupEnumerator.Create(FItems, FCount, CompareFunction, Sorted);
end;

function TArrayList.Search(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean): Pointer;
var
Index: Integer;
begin
if Sorted then
Index := G_BinarySearch(Value, FItems, FCount, MatchFunction)
else
Index := G_Search(Value, FItems, FCount, MatchFunction);
if Index >= 0 then
Result := FItems^[Index]
else
Result := nil;
end;

function TArrayList.IndexOf(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean): Integer;
begin
if Sorted then
Result := G_BinarySearch(Value, FItems, FCount, MatchFunction)
else
Result := G_Search(Value, FItems, FCount, MatchFunction);
end;

procedure TArrayList.RemoveAt(Index: Integer);
begin
if LongWord(Index) >= LongWord(FCount) then
RaiseError(SErrIndexOutOfRange);
if FOwnItems then
TObject(FItems^[Index]).Free;
Dec(FCount);
if Index < FCount then
G_MoveLongs(@FItems^[Index + 1], @FItems^[Index], FCount - Index);
end;

procedure TArrayList.RemoveAt(Index, Count: Integer);
var
I: Integer;
begin
if LongWord(Index) > LongWord(FCount) then
RaiseError(SErrIndexOutOfRange);
if LongWord(Index + Count) >= LongWord(FCount) then
begin
if FOwnItems then
for I := FCount - 1 downto Index do
TObject(FItems^[I]).Free;
FCount := Index;
end
else if Count > 0 then
begin
if FOwnItems then
for I := Index + Count - 1 downto Index do
TObject(FItems^[I]).Free;
Dec(FCount, Count);
G_MoveLongs(@FItems^[Index + Count], @FItems^[Index], FCount - Index);
end;
end;

procedure TArrayList.UnorderedRemoveAt(Index: Integer);
begin
if LongWord(Index) >= LongWord(FCount) then
RaiseError(SErrIndexOutOfRange);
if FOwnItems then
TObject(FItems^[Index]).Free;
Dec(FCount);
if Index < FCount then
FItems^[Index] := FItems^[FCount];
end;

procedure TArrayList.Clear(SuppressDisposingItems: Boolean);
var
I: Integer;
begin
if FOwnItems and not SuppressDisposingItems then
for I := FCount - 1 downto 0 do
TObject(FItems^[I]).Free;
FCount := 0;
end;

procedure TArrayList.TrimToSize;
begin
if FCount < FCapacity then
SetCapacity(FCount);
end;

function TArrayList.Equals(ArrayList: TArrayList;
CompareFunction: TCompareFunction): Boolean;
var
P1, P2: Pointer;
I: Integer;
begin
if ArrayList = Self then
Result := True
else if (ArrayList <> nil) and (ArrayList.FCount = FCount) then
begin
if not Assigned(CompareFunction) then
Result := G_SameLongs(FItems, ArrayList.FItems, FCount)
else
begin
Result := False;
for I := FCount - 1 downto 0 do
begin
P1 := FItems^[I];
P2 := ArrayList.FItems^[I];
if (P1 <> P2) and (CompareFunction(P1, P2) <> 0) then
Exit;
end;
Result := True;
end;
end else
Result := False;
end;

function TArrayList.Clone: TArrayList;
begin
Result := TArrayList.Create(FCount);
if FCount > 0 then
G_CopyLongs(FItems, Result.FItems, FCount);
Result.FCount := FCount;
end;

{ TArrayReadOnlyList }

constructor TArrayReadOnlyList.Create(ItemList: PPointerItemList; Count: Integer);
begin
FItems := ItemList;
FCount := Count;
end;

function TArrayReadOnlyList.ScanPointer(P: Pointer): Integer;
begin
Result := G_Scan_Pointer(P, FItems, FCount);
end;

procedure TArrayReadOnlyList.Sort(CompareFunction: TCompareFunction);
begin
G_Sort(FItems, FCount, CompareFunction);
end;

procedure TArrayReadOnlyList.StableSort(CompareFunction: TCompareFunction);
begin
G_StableSort(FItems, FCount, CompareFunction);
end;

function TArrayReadOnlyList.EnumerateGroups(CompareFunction: TCompareFunction;
Sorted: Boolean): TGroupEnumerator;
begin
Result := TGroupEnumerator.Create(FItems, FCount, CompareFunction, Sorted);
end;

function TArrayReadOnlyList.Search(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean): Pointer;
var
Index: Integer;
begin
if Sorted then
Index := G_BinarySearch(Value, FItems, FCount, MatchFunction)
else
Index := G_Search(Value, FItems, FCount, MatchFunction);
if Index >= 0 then
Result := FItems^[Index]
else
Result := nil;
end;

function TArrayReadOnlyList.IndexOf(Value: Pointer; MatchFunction: TMatchFunction;
Sorted: Boolean): Integer;
begin
if Sorted then
Result := G_BinarySearch(Value, FItems, FCount, MatchFunction)
else
Result := G_Search(Value, FItems, FCount, MatchFunction);
end;

function TArrayReadOnlyList.Equals(ArrayList: TArrayReadOnlyList;
CompareFunction: TCompareFunction): Boolean;
var
P1, P2: Pointer;
I: Integer;
begin
if ArrayList = Self then
Result := True
else if (ArrayList <> nil) and (ArrayList.FCount = FCount) then
begin
if not Assigned(CompareFunction) then
Result := G_SameLongs(FItems, ArrayList.FItems, FCount)
else
begin
Result := False;
for I := FCount - 1 downto 0 do
begin
P1 := FItems^[I];
P2 := ArrayList.FItems^[I];
if (P1 <> P2) and (CompareFunction(P1, P2) <> 0) then
Exit;
end;
Result := True;
end;
end else
Result := False;
end;

function TArrayReadOnlyList.Equals(ArrayList: TArrayList;
CompareFunction: TCompareFunction): Boolean;
var
P1, P2: Pointer;
I: Integer;
begin
if (ArrayList <> nil) and (ArrayList.FCount = FCount) then
begin
if not Assigned(CompareFunction) then
Result := G_SameLongs(FItems, ArrayList.FItems, FCount)
else
begin
Result := False;
for I := FCount - 1 downto 0 do
begin
P1 := FItems^[I];
P2 := ArrayList.FItems^[I];
if (P1 <> P2) and (CompareFunction(P1, P2) <> 0) then
Exit;
end;
Result := True;
end;
end else
Result := False;
end;

function TArrayReadOnlyList.Clone: TArrayList;
begin
Result := TArrayList.Create(FCount);
if FCount > 0 then
G_CopyLongs(FItems, Result.FItems, FCount);
Result.FCount := FCount;
end;

{ TGroupEnumerator }

constructor TGroupEnumerator.Create(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction; Sorted: Boolean);
var
I, N, P: Integer;
begin
if Count > 0 then
begin
if not Sorted then
G_Sort(ItemList, Count, CompareFunction);
N := 1;
for I := 1 to Count - 1 do
if CompareFunction(ItemList^[I - 1], ItemList^[I]) <> 0 then
Inc(N);
FGroupCount := N;
GetMem(FGroups, N * SizeOf(Pointer));
N := 0;
P := 0;
for I := 1 to Count - 1 do
if CompareFunction(ItemList^[I - 1], ItemList^[I]) <> 0 then
begin
FGroups^[N] := TArrayReadOnlyList.Create(@ItemList^[P], I - P);
Inc(N);
P := I;
end;
FGroups^[N] := TArrayReadOnlyList.Create(@ItemList^[P], Count - P);
end;
end;

destructor TGroupEnumerator.Destroy;
var
I: Integer;
begin
if FGroupCount > 0 then
begin
for I := FGroupCount - 1 downto 0 do
FGroups^[I].Free;
FreeMem(FGroups);
end;
end;

{ TStringHashtable }

constructor TStringHashtable.Create(CaseSensitive: Boolean;
InitialCapacity: Integer);
var
N: Integer;
begin
N := G_EnlargePrimeCapacity((InitialCapacity * 7) div 5);
FCapacity := N;
FMaxCount := (N * 5) div 7;
FCaseSensitive := CaseSensitive;
GetMem(FKeys, N shl 2);
GetMem(FValues, N shl 2);
G_FillLongs(0, FKeys, N);
end;

destructor TStringHashtable.Destroy;
var
I: Integer;
P: Pointer;
begin
for I := FCapacity - 1 downto 0 do
begin
P := Pointer(FKeys^[I]);
if (P <> nil) and (P <> MissingStringHashKey) then
begin
if FOwnValues then
TObject(FValues^[I]).Free;
FKeys^[I] := '';
end;
end;
FreeMem(FKeys);
FreeMem(FValues);
end;

procedure TStringHashtable.SetMaxCount(NewMaxCount: Integer);
var
N: Integer;
begin
if NewMaxCount >= FCount then
begin
N := G_EnlargePrimeCapacity((NewMaxCount * 7) div 5);
if N <> FCapacity then
SetCapacity(N);
end;
end;

function TStringHashtable.GetIndex(P: Pointer): Integer;
var
X, HashSize, HashStep: LongWord;
begin
if not FCaseSensitive then
X := G_CRC32_Text(P)
else
X := G_CRC32_Str(P);
HashSize := LongWord(FCapacity);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
if Pointer(FKeys^[X]) = nil then
begin
Result := X;
Exit;
end;
Inc(X, HashStep);
end;
end;

procedure TStringHashtable.SetCapacity(NewCapacity: Integer);
var
PrevKeys: PStringItemList;
PrevValues: PPointerItemList;
P: Pointer;
N, I: Integer;
begin
N := NewCapacity;
I := FCapacity - 1;
PrevKeys := FKeys;
PrevValues := FValues;
FCapacity := N;
FMaxCount := (N * 5) div 7;
GetMem(FKeys, N shl 2);
GetMem(FValues, N shl 2);
G_FillLongs(0, FKeys, N);
while I >= 0 do
begin
P := Pointer(PrevKeys^[I]);
if (P <> nil) and (P <> MissingStringHashKey) then
begin
N := GetIndex(P);
Pointer(FKeys^[N]) := P;
FValues^[N] := PrevValues^[I];
end;
Dec(I);
end;
FreeMem(PrevKeys);
FreeMem(PrevValues);
end;

function TStringHashtable.GetItem(const Key: string): Pointer;
var
X, HashSize, HashStep: LongWord;
P: Pointer;
begin
HashSize := LongWord(FCapacity);
if not FCaseSensitive then
begin
X := G_CRC32_Text(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if P = nil then
Break;
if (P <> MissingStringHashKey) and G_SameText(P, Pointer(Key)) then
begin
Result := FValues^[X];
Exit;
end;
Inc(X, HashStep);
end;
end else
begin
X := G_CRC32_Str(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if P = nil then
Break;
if (P <> MissingStringHashKey) and G_SameStr(P, Pointer(Key)) then
begin
Result := FValues^[X];
Exit;
end;
Inc(X, HashStep);
end;
end;
Result := nil;
end;

procedure TStringHashtable.SetItem(const Key: string; Value: Pointer);
var
X, HashSize, HashStep: LongWord;
L: Integer;
P: Pointer;
O: Pointer;
begin
HashSize := LongWord(FCapacity);
L := -1;
if not FCaseSensitive then
begin
X := G_CRC32_Text(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if (P <> nil) and (P <> MissingStringHashKey) then
begin
if G_SameText(P, Pointer(Key)) then
begin
if not FOwnValues then
FValues^[X] := Value
else
begin
O := FValues^[X];
if O <> Value then
begin
FValues^[X] := Value;
TObject(O).Free;
end;
end;
Exit;
end;
end else
begin
if L < 0 then
L := X;
if P = nil then
Break;
end;
Inc(X, HashStep);
end;
end else
begin
X := G_CRC32_Str(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if (P <> nil) and (P <> MissingStringHashKey) then
begin
if G_SameStr(P, Pointer(Key)) then
begin
if not FOwnValues then
FValues^[X] := Value
else
begin
O := FValues^[X];
if O <> Value then
begin
FValues^[X] := Value;
TObject(O).Free;
end;
end;
Exit;
end;
end else
begin
if L < 0 then
L := X;
if P = nil then
Break;
end;
Inc(X, HashStep);
end;
end;
if FCount >= FMaxCount then
begin
SetCapacity(G_EnlargePrimeCapacity(FCapacity));
L := GetIndex(Pointer(Key));
end;
Pointer(FKeys^[L]) := nil;
FKeys^[L] := Key;
FValues^[L] := Value;
Inc(FCount);
end;

procedure TStringHashtable.EnsureCapacity(Capacity: Integer);
begin
if FMaxCount < Capacity then
SetCapacity(G_EnlargePrimeCapacity((Capacity * 7) div 5));
end;

procedure TStringHashtable.Add(const Key: string; Value: Pointer);
var
X, HashSize, HashStep: LongWord;
L: Integer;
P: Pointer;
begin
HashSize := LongWord(FCapacity);
L := -1;
if not FCaseSensitive then
begin
X := G_CRC32_Text(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if (P <> nil) and (P <> MissingStringHashKey) then
begin
if G_SameText(P, Pointer(Key)) then
RaiseErrorFmt(SErrKeyDuplicatesInAssociationList, 'TStringHashtable');
end else
begin
if L < 0 then
L := X;
if P = nil then
Break;
end;
Inc(X, HashStep);
end;
end else
begin
X := G_CRC32_Str(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if (P <> nil) and (P <> MissingStringHashKey) then
begin
if G_SameStr(P, Pointer(Key)) then
RaiseErrorFmt(SErrKeyDuplicatesInAssociationList, 'TStringHashtable');
end else
begin
if L < 0 then
L := X;
if P = nil then
Break;
end;
Inc(X, HashStep);
end;
end;
if FCount >= FMaxCount then
begin
SetCapacity(G_EnlargePrimeCapacity(FCapacity));
L := GetIndex(Pointer(Key));
end;
Pointer(FKeys^[L]) := nil;
FKeys^[L] := Key;
FValues^[L] := Value;
Inc(FCount);
end;

function TStringHashtable.Contains(const Key: string): Boolean;
var
X, HashSize, HashStep: LongWord;
P: Pointer;
begin
HashSize := LongWord(FCapacity);
if not FCaseSensitive then
begin
X := G_CRC32_Text(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if P = nil then
Break;
if (P <> MissingStringHashKey) and G_SameText(P, Pointer(Key)) then
begin
Result := True;
Exit;
end;
Inc(X, HashStep);
end;
end else
begin
X := G_CRC32_Str(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if P = nil then
Break;
if (P <> MissingStringHashKey) and G_SameStr(P, Pointer(Key)) then
begin
Result := True;
Exit;
end;
Inc(X, HashStep);
end;
end;
Result := False;
end;

procedure TStringHashtable.Remove(const Key: string);
var
X, HashSize, HashStep: LongWord;
P: Pointer;
begin
HashSize := LongWord(FCapacity);
if not FCaseSensitive then
begin
X := G_CRC32_Text(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if P = nil then
Break;
if (P <> MissingStringHashKey) and G_SameText(P, Pointer(Key)) then
begin
FKeys^[X] := '';
Pointer(FKeys^[X]) := MissingStringHashKey;
if FOwnValues then
TObject(FValues^[X]).Free;
Dec(FCount);
Exit;
end;
Inc(X, HashStep);
end;
end else
begin
X := G_CRC32_Str(Key);
HashStep := (((X shr 5) + 1) mod (HashSize - 1)) + 1;
while True do
begin
X := X mod HashSize;
P := Pointer(FKeys^[X]);
if P = nil then
Break;
if (P <> MissingStringHashKey) and G_SameStr(P, Pointer(Key)) then
begin
FKeys^[X] := '';
Pointer(FKeys^[X]) := MissingStringHashKey;
if FOwnValues then
TObject(FValues^[X]).Free;
Dec(FCount);
Exit;
end;
Inc(X, HashStep);
end;
end;
end;

procedure TStringHashtable.Clear(SuppressDisposingValues: Boolean);
var
I: Integer;
P: Pointer;
begin
for I := FCapacity - 1 downto 0 do
begin
P := Pointer(FKeys^[I]);
if (P <> nil) and (P <> MissingStringHashKey) then
begin
if FOwnValues and not SuppressDisposingValues then
TObject(FValues^[I]).Free;
FKeys^[I] := '';
end;
end;
G_FillLongs(0, FKeys, FCapacity);
FCount := 0;
end;

end.