unit uBinaryArraySet;
{ adapted from code by ASerge }
{$Mode objfpc}
{$LongStrings on}
{$ModeSwitch advancedrecords}
interface
uses
Types, sysutils;
type
generic TBinaryArraySet<T> = record
strict private type
TSlots = array of T;
strict private
function MergeSlots(const Left, Right: TSlots): TSlots;
public
Slots: array of TSlots;
function Contains(const Value: T): Boolean; overload;
function Contains(const value: T; out DataIdx, SlotsIdx: Integer): Boolean; overload;
function Added(const Value: T): Boolean;
procedure AddUnique(const Value: T);
procedure Clear;
function ToSortedArray: TSlots;
function GetSize: SizeInt;
end;
function ParsedToLoCaseWords(aLine: String): TStringDynArray;
implementation
function ParsedToLoCaseWords(aLine: String): TStringDynArray;
var
wrd: String = '';
p, resultIdx: Integer;
c: Char;
begin
aLine := Trim(aLine);
SetLength(Result, Length(aLine) shr 1);
resultIdx := 0;
for p := 1 to Length(aLine) do
begin
c := LowerCase(aLine[p]);
case (c in ['''', 'a'..'z']) of
False: if Length(wrd) > 0 then
begin
Result[resultIdx] := wrd;
Inc(resultIdx);
wrd := '';
end;
True: wrd := wrd + c;
end;
end;
if wrd <> '' then
begin
Result[resultIdx] := wrd;
Inc(resultIdx);
end;
SetLength(Result, resultIdx);
end;
function TBinaryArraySet.Added(const Value: T): Boolean;
begin
case Contains(Value) of
True: Result := False;
False: begin
AddUnique(Value);
Result := True;
end;
end;
end;
procedure TBinaryArraySet.AddUnique(const Value: T);
var
Temp: TSlots;
DataIndex: SizeInt;
begin
SetLength(Temp, 1);
Temp[0] := Value;
for DataIndex := 0 to High(Slots) do
begin
if not Assigned(Slots[DataIndex]) then
begin
Slots[DataIndex] := Temp;
Exit;
end;
Temp := MergeSlots(Temp, Slots[DataIndex]);
Slots[DataIndex] := nil;
end;
SetLength(Slots, Length(Slots) + 1);
Slots[High(Slots)] := Temp;
end;
procedure TBinaryArraySet.Clear;
begin
Slots := Nil;
end;
function TBinaryArraySet.Contains(const Value: T): Boolean;
var
slotIndex: SizeInt;
startIndex, endIndex, midIndex: SizeInt;
begin
for slotIndex := 0 to High(Slots) do
begin
if not Assigned(Slots[slotIndex]) then
Continue;
startIndex := 0;
endIndex := Length(Slots[slotIndex]);
while startIndex < endIndex do
begin
midIndex := (startIndex + endIndex) shr 1;
if Value = Slots[slotIndex][midIndex] then
Exit(True);
if Value < Slots[slotIndex][midIndex] then
endIndex := midIndex
else
startIndex := midIndex + 1;
end;
end;
Result := False;
end;
function TBinaryArraySet.Contains(const value: T; out DataIdx, SlotsIdx: Integer): Boolean;
var
slotIndex: SizeInt;
startIndex, endIndex, midIndex: SizeInt;
begin
for slotIndex := 0 to High(Slots) do
begin
if not Assigned(Slots[slotIndex]) then
Continue;
startIndex := 0;
endIndex := Length(Slots[slotIndex]);
while startIndex < endIndex do
begin
midIndex := (startIndex + endIndex) div 2;
if Value = Slots[slotIndex][midIndex] then
begin
DataIdx := slotIndex;
SlotsIdx := midIndex;
Exit(True);
end;
if Value < Slots[slotIndex][midIndex] then
endIndex := midIndex
else
startIndex := midIndex + 1;
end;
end;
Result := False;
DataIdx := -1;
SlotsIdx := -1;
end;
function TBinaryArraySet.MergeSlots(const Left, Right: TSlots): TSlots;
var
leftIndex: SizeInt = 0;
rightIndex: SizeInt = 0;
resultIndex: SizeInt = 0;
begin
SetLength(Result, Length(Left) + Length(Right));
while (leftIndex < Length(Left)) and (rightIndex < Length(Right)) do
begin
if Left[leftIndex] < Right[rightIndex] then
begin
Result[resultIndex] := Left[leftIndex];
Inc(leftIndex);
end
else
begin
Result[resultIndex] := Right[rightIndex];
Inc(rightIndex);
end;
Inc(resultIndex);
end;
while leftIndex < Length(Left) do
begin
Result[resultIndex] := Left[leftIndex];
Inc(leftIndex);
Inc(resultIndex);
end;
while rightIndex < Length(Right) do
begin
Result[resultIndex] := Right[rightIndex];
Inc(rightIndex);
Inc(resultIndex);
end;
end;
function TBinaryArraySet.ToSortedArray: TSlots;
var
slotIdx: SizeInt;
begin
Result := Nil;
for slotIdx := 0 to High(Slots) do
Result := MergeSlots(Result, Slots[slotIdx]);
end;
function TBinaryArraySet.GetSize: SizeInt;
var
slotIdx: Integer;
begin
Result := 0;
for slotIdx := 0 to High(Slots) do
if Assigned(Slots[slotIdx]) then
Inc(Result, Length(Slots[slotIdx]));
end;
end.