program proj;
{$mode objfpc}{$h+}
{$modeswitch advancedrecords}
{$maxstacksize $40000000}
uses
SysUtils, Math, lgUtils, lgHashSet, lgHash, lgTreeSet;
var
ArrayLen: Integer = 10000;
RepCount: Integer = 1000;
const
TryCount = 5;
type
THelper = record
class function HashCode(aValue: DWord): SizeInt; static; inline;
class function Equal(L, R: DWord): Boolean; static; inline;
end;
generic TRangeTest<const UpBound: Integer> = record
const
UPPER = UpBound or Ord(UpBound = 0);
type
TElType = 1..UPPER;
TElArray = array of TElType;
TRemoveDuplicates = function(const a: array of TElType): TElArray;
TTestFun = record
Fun: TRemoveDuplicates;
DisplayText: string;
end;
TBitSet = specialize TGSet<TElType>;
THashSetType = specialize TGLiteChainHashSet<TElType, THelper>;
THashSet = THashSetType.TSet;
TTreeSet = specialize TGLiteTreeSet<TElType, DWord>;
class function BitSet(const a: array of TElType): TElArray; static;
class function HashSet(const a: array of TElType): TElArray; static;
class function TreeSet(const a: array of TElType): TElArray; static;
class procedure Execute; static;
end;
class function THelper.HashCode(aValue: DWord): SizeInt;
begin
Result := JdkHash(aValue);
end;
class function THelper.Equal(L, R: DWord): Boolean;
begin
Result := L = R;
end;
class function TRangeTest.BitSet(const a: array of TElType): TElArray;
var
s: TBitSet;
I, J: SizeInt;
begin
SetLength(Result, Length(a));
J := 0;
for I := 0 to High(a) do
begin
if a[I] in s then continue;
s.Include(a[I]);
Result[J] := a[I];
Inc(J);
end;
SetLength(Result, J);
end;
{$warn 5089 off}
class function TRangeTest.HashSet(const a: array of TElType): TElArray;
var
s: THashSet;
I, J: SizeInt;
begin
s.EnsureCapacity(Min(Ord(High(TElType)) - Ord(Low(TElType)) + 1, Length(a)));
SetLength(Result, Length(a));
J := 0;
for I := 0 to High(a) do
if s.Add(a[I]) then
begin
Result[J] := a[I];
Inc(J);
end;
SetLength(Result, J);
end;
class function TRangeTest.TreeSet(const a: array of TElType): TElArray;
var
s: TTreeSet;
I, J: SizeInt;
begin
s.EnsureCapacity(Min(Ord(High(TElType)) - Ord(Low(TElType)) + 1, Length(a)));
SetLength(Result, Length(a));
J := 0;
for I := 0 to High(a) do
if s.Add(a[I]) then
begin
Result[J] := a[I];
Inc(J);
end;
SetLength(Result, J);
end;
class procedure TRangeTest.Execute;
var
a, u: TElArray;
CurrFun: TTestFun;
I, J: SizeInt;
BestScore, Score: QWord;
const
TestFuns: array of TTestFun = (
(Fun: @BitSet; DisplayText: ' BitSet: '),
(Fun: @HashSet; DisplayText: ' HashSet: '),
(Fun: @TreeSet; DisplayText: ' TreeSet: ')
);
begin
WriteLn(' Subrange: 1..', UPPER);
SetLength(a, ArrayLen);
for I := 0 to High(a) do
a[I] := Random(UPPER) + 1;
for CurrFun in TestFuns do
begin
BestScore := High(QWord);
for I := 1 to TryCount do
begin
Score := GetTickCount64;
for J := 1 to RepCount do
u := CurrFun.Fun(a);
Score := GetTickCount64 - Score;
if Score < BestScore then
BestScore := Score;
end;
WriteLn(CurrFun.DisplayText, BestScore);
end;
end;
procedure RunTest;
begin
WriteLn('Array length: ', ArrayLen);
specialize TRangeTest<1024>.Execute;
specialize TRangeTest<65536>.Execute;
specialize TRangeTest<4194304>.Execute;
specialize TRangeTest<268435456>.Execute;
specialize TRangeTest<2147483647>.Execute;
WriteLn;
end;
begin
RunTest;
ArrayLen := 50000; RepCount := 200;
RunTest;
ArrayLen := 200000; RepCount := 50;
RunTest;
ArrayLen := 1000000; RepCount := 10;
RunTest;
ArrayLen := 5000000; RepCount := 2;
RunTest;
ReadLn;
end.