program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
// ***
// *
// * Für Mäusekino einfach mal ausschalten
// *
{$DEFINE MAENNER_HASH}
// *
// ***
uses
System.Diagnostics,
System.Generics.Collections,
System.Generics.Defaults,
System.SysUtils;
type
TGuid =
record
private
FTS1: TDateTime;
FTS2: TDateTime;
FC : LongWord;
public
class operator Equal(
const L, R: TGuid ): Boolean;
function GetHashCode( ): Integer;
property TS1: TDateTime
read FTS1
write FTS1;
property TS2: TDateTime
read FTS2
write FTS2;
property C: LongWord
read FC
write FC;
end;
TGuidOrgEqualityComparer =
class( TEqualityComparer<TGuid> )
public
function Equals(
const Left, Right: TGuid ): Boolean;
override;
function GetHashCode(
const Value: TGuid ): Integer;
override;
end;
{ TGuid }
class operator TGuid.Equal(
const L, R: TGuid ): Boolean;
begin
Result := ( L.TS1 = R.TS1 )
and ( L.TS2 = R.TS2 )
and ( L.C = R.C );
end;
function TGuid.GetHashCode: Integer;
begin
{$IFDEF MAENNER_HASH}
Result := 17;
Result := Result * 397 + FC;
Result := Result * 397 + BobJenkinsHash( FTS1, sizeOf( TDateTime ), 5 );
Result := Result * 397 + BobJenkinsHash( FTS2, sizeOf( TDateTime ), 7 );
{$ELSE}
Result := FC;
{$ENDIF}
end;
{ TGuidOrgEqualityComparer }
function TGuidOrgEqualityComparer.Equals(
const Left, Right: TGuid ): Boolean;
begin
Result := ( Left = Right );
end;
function TGuidOrgEqualityComparer.GetHashCode(
const Value: TGuid ): Integer;
begin
Result := Value.GetHashCode;
end;
procedure Test;
var
lCount: Integer;
lDict : TDictionary<TGuid, Integer>;
lsw : TStopWatch;
lTS1 : TDateTime;
lGuid : TGuid;
begin
lsw := TStopWatch.Create;
lCount := 0;
while lCount < 10
do
begin
lDict := TDictionary<TGuid, Integer>.Create( TGuidOrgEqualityComparer.Create );
try
lsw.Start;
lTS1 := Now;
while lDict.Count < 50000
do
begin
lGuid.TS1 := lTS1;
lGuid.TS2 := Random * 2000;
lGuid.C := Random( 10000 );
lDict.Add( lGuid, 0 );
if lDict.Count
mod 1000 = 0
then
write( '
.' );
end;
Writeln;
lsw.Stop;
finally
lDict.Free;
end;
inc( lCount );
end;
Writeln( '
Schnitt: ', ( lsw.ElapsedMilliseconds / lCount ):0:2, '
ms' );
end;
begin
Randomize;
try
Test;
except
on E:
Exception do
Writeln( E.ClassName, '
: ', E.
Message );
end;
ReadLn;
end.