program project1;
{.$DEFINE TestStr}
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp,
{ you can add units after this }
CRC,
fgl,
gmap,
ghashmap,
contnrs;
const
DefValue = pointer(1);
type
{ TMyApplication }
TValue = pointer;
{$IFDEF TestStr}
TKey = ansistring;
{$ELSE}
TKey = int64;
{$ENDIF}
{ THashDirectFunc }
THashDirectInt64 = class
// return uniformly distributed i value in range <0,n-1> base only on arguments,
// n will be always power of 2
class function hash(a: int64; n: SizeUInt): SizeUInt;
// [when STL_INTERFACE_EXT is defined]
// return the boolean test for equality of the two keys. Typically this is operator=,
// but it doesn't have to be (e.g. case-insensitive string comparison)
class function equal(const AKey1, AKey2: int64): Boolean;
end;
THashFuncString = class
// return uniformly distributed i value in range <0,n-1> base only on arguments,
// n will be always power of 2
class function hash(a: string; n: SizeUInt): SizeUInt;
// [when STL_INTERFACE_EXT is defined]
// return the boolean test for equality of the two keys. Typically this is operator=,
// but it doesn't have to be (e.g. case-insensitive string comparison)
class function equal(const AKey1, AKey2: string): Boolean;
end;
{ TMapCompare }
{$IFDEF TestStr}
TTestGHashMap = specialize THashMap<TKey, TValue, THashFuncString>;
{$ELSE}
TTestGHashMap = specialize THashMap<TKey, TValue, THashDirectInt64>;
{$ENDIF}
TMapCompare=class
class function c(a,b :TKey):boolean;
end;
TTestGMap = specialize TMap<TKey, TValue, TMapCompare>;
TTestFPGMap = specialize TFPGMap<TKey, TValue>;
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
list1: TFPHashList;
map1: TTestGHashMap;
map2: TTestFPGMap;
map3: TTestGMap;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
//// //// //// //// //// //// //// //// //// //// //// //// //// //// //// ////
function RandomOf(RandKey: LongInt): integer;
Begin
Result := RandKey * 1103515245 + 12345;
enD;
{$IFDEF TestStr}
function RndKeyStr(i: LongInt): ansistring;
begin
Result := IntToStr(Int64( Abs(RandomOf(i)) or $1000000000000000) );
end;
{$ELSE}
function RndKeyStr(i: LongInt): ansistring;
begin
// create strong 8 byte string
Result := IntToHex(RandomOf(i), 8);
end;
{$ENDIF}
{$IFDEF TestStr}
function RndKey(i: LongInt): ansistring;
begin
Result := RndKeyStr(i);
end;
{$ELSE}
function RndKey(i: LongInt): int64;
begin
Result := RandomOf(i);
end;
{$ENDIF}
{ TMapCompare }
class function TMapCompare.c(a, b: TKey): boolean;
begin
{$IFDEF TestStr}
Result := CompareStr(a, b) > 0;
{$ELSE}
Result := a > b;
{$ENDIF}
end;
//// //// //// //// //// //// //// //// //// //// //// //// //// //// //// ////
class function THashFuncString.hash(a: string; n: SizeUInt): SizeUInt;
begin
Result := CRC.CRC32(n, @a[1], Length(a)) mod n;
end;
class function THashFuncString.equal(const AKey1, AKey2: string): Boolean;
begin
Result := AKey1 = AKey2;
end;
class function THashDirectInt64.hash(a: int64; n: SizeUInt): SizeUInt;
begin
Result := SizeUInt(RandomOf(a)) mod n;
end;
class function THashDirectInt64.equal(const AKey1, AKey2: int64): Boolean;
begin
Result := AKey1 = AKey2;
end;
//// //// //// //// //// //// //// //// //// //// //// //// //// //// //// ////
function UsedMem(): integer;
var mem: TFPCHeapStatus;
begin
mem := SysGetFPCHeapStatus();
Result := mem.CurrHeapUsed;
end;
{ TMyApplication }
procedure TMyApplication.DoRun;
var
i, i2, itmp: integer;
t: int64;
c: int64;
value: TValue;
p: pointer;
basemem: integer;
begin
c := StrToInt64Def(self.GetOptionValue('c', 'count'), 100000);
{$IFDEF TestStr}
writeln('Test key: string');
{$ELSE}
writeln('Test key: int64 (or string[8] for TFPHashList)');
{$ENDIF}
writeln('Count: ' + IntToStr(c));
writeln('');
writeln('THashMap:');
basemem := UsedMem();
map1 := TTestGHashMap.create();
writeln('Create. ' + ' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i:=1 to c do
begin
map1.insert(RndKey(i), DefValue);
end;
writeln('Adding. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i2:=1 to 10 do
for i:=1 to c do
begin
if not map1.GetValue(RndKey(i), value) then
raise EKeyNotFound.Create('THashMap find error') else
if value <> DefValue then
raise EKeyNotFound.Create('THashMap find error 2') else
end;
for i:=1 to c do
begin
map1.GetValue(RndKey(c+i), value);
end;
writeln('Read. Time: ' + IntToStr(GetTickCount64() - t));
t := GetTickCount64();
for i:=1 to c do
begin
if map1.contains(RndKey(i)) then
map1.delete(RndKey(i));
end;
writeln('Delete. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
FreeAndNil(map1);
writeln('Free. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
writeln('');
writeln('TMap:');
basemem := UsedMem();
map3 := TTestGMap.create();
writeln('Create. ' + ' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i:=1 to c do
begin
map3.insert(RndKey(i), DefValue);
end;
writeln('Adding. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i2:=1 to 10 do
for i:=1 to c do
begin
if not map3.TryGetValue(RndKey(i), value) then
raise EKeyNotFound.Create('THashMap find error') else
if value <> DefValue then
raise EKeyNotFound.Create('THashMap find error 2') else
end;
for i:=1 to c do
begin
map3.TryGetValue(RndKey(c+i), value);
end;
writeln('Read. Time: ' + IntToStr(GetTickCount64() - t));
t := GetTickCount64();
for i:=1 to c do
begin
if map3.TryGetValue(RndKey(i), value) then
map3.delete(RndKey(i));
end;
writeln('Delete. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
FreeAndNil(map3);
writeln('Free. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
writeln('');
writeln('TFPGMap:');
basemem := UsedMem();
map2 := TTestFPGMap.Create();
map2.Sorted:=true;
writeln('Create. ' + ' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i:=1 to c do
begin
map2.Add(RndKey(i), DefValue);
end;
writeln('Adding. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i2:=1 to 10 do
for i:=1 to c do
begin
map2.Find(RndKey(i), itmp);
if itmp = -1 then
raise EKeyNotFound.Create('TFPGMap find error');
end;
for i:=1 to c do
begin
map2.Find(RndKey(c+i), itmp);
end;
writeln('Read. Time: ' + IntToStr(GetTickCount64() - t));
t := GetTickCount64();
for i:=1 to c do
begin
map2.Find(RndKey(i), itmp);
if itmp<>-1 then
map2.Delete(itmp);
end;
writeln('Delete. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
FreeAndNil(map2);
writeln('Free. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
writeln('');
writeln('TFPHashList:');
basemem := UsedMem();
list1 := TFPHashList.Create();
writeln('Create. ' + ' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i:=1 to c do
begin
list1.Add(RndKeyStr(i), DefValue);
end;
writeln('Adding. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
for i2:=1 to 10 do
for i:=1 to c do
begin
if list1.Find(RndKeyStr(i)) = nil then
raise EKeyNotFound.Create('TFPHashList find error');
end;
for i:=1 to c do
begin
list1.Find(RndKeyStr(c+i));
end;
writeln('Read. Time: ' + IntToStr(GetTickCount64() - t));
t := GetTickCount64();
for i:=1 to c do
begin
itmp := list1.FindIndexOf(RndKeyStr(i));
if itmp <> -1 then
list1.Delete(itmp);
end;
writeln('Delete. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
FreeAndNil(list1);
writeln('Free. Time: ' + IntToStr(GetTickCount64() - t) +
' Used mem: ' + IntToStr(UsedMem()-basemem));
t := GetTickCount64();
writeln('End.');
ReadLn();
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ', ExeName, ' -h');
end;
var
Application: TMyApplication;
begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.Run;
Application.Free;
end.