program Project2; {$APPTYPE CONSOLE} {$R *.res} uses windows, System.SysUtils; function memcmp(ptr1: PAnsiChar; ptr2: PAnsiChar; num: DWORD): Integer; cdecl; external 'Ntdll.dll' name 'memcmp'; function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs; external 'msvcrt.dll'; function ZStartTime(var StartTime: Int64): Boolean; begin Result := QueryPerformanceCounter(StartTime); end; function ZStopTime(const StartTime: Int64): AnsiString; var iCounterPerSec, StopTime: Int64; time: Single; begin if QueryPerformanceCounter(StopTime) then begin if QueryPerformanceFrequency(iCounterPerSec) then begin time := (0 - StartTime + StopTime) / iCounterPerSec; Result := ''; SetLength(Result, 25); SetLength(Result, sprintf(PAnsiChar(Result), 'Result: %f sec.', time)); end else Result := 'Error[ZStopTime(QueryPerformanceFrequency)]'; end else Result := 'Error[ZStopTime(QueryPerformanceCounter)]'; end; function base64_encode(const str: string): string; const table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; type PArrayChars = ^TArrayChars; TArrayChars = array of char; var len, i, r: Integer; a, b: Byte; Sum: Cardinal; begin len := Length(str); SetLength(Result, ((len + 2) div 3) * 4); i := 0; r := 0; while i <= len - 3 do begin Sum := WORD(str[i + 1]) shl 16 + WORD(str[i + 2]) shl 8 + WORD(str[i + 3]); PArrayChars(@Result)^[r + 0] := table[Sum shr 18 and $3F]; PArrayChars(@Result)^[r + 1] := table[Sum shr 12 and $3F]; PArrayChars(@Result)^[r + 2] := table[Sum shr 6 and $3F]; PArrayChars(@Result)^[r + 3] := table[Sum and $3F]; inc(i, 3); inc(r, 4); end; case len mod 3 of 1: begin a := WORD(str[len]) and $FF; PArrayChars(@Result)^[r + 0] := table[a SHR 2]; PArrayChars(@Result)^[r + 1] := table[a and 3 SHL 4]; PArrayChars(@Result)^[r + 2] := '='; PArrayChars(@Result)^[r + 3] := '='; end; 2: begin a := WORD(str[i + 1]) and $FF; b := WORD(str[i + 2]) and $FF; PArrayChars(@Result)^[r + 0] := table[a SHR 2]; PArrayChars(@Result)^[r + 1] := table[((a and 3) SHL 4) or (b SHR 4)]; PArrayChars(@Result)^[r + 2] := table[b and $0F SHL 2]; PArrayChars(@Result)^[r + 3] := '='; end; end; end; var i: Cardinal; StartTime: Int64; begin try Writeln(base64_encode('HytujkyHytujkyukHytujkyukuk')); if ZStartTime(StartTime) then begin for i := 0 to 10000000 do begin base64_encode('HytujkyHytujkyukHytujkyukuk'); end; Writeln(ZStopTime(StartTime)); end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
function ELFHash(const Value: String): Integer;
var
i, x: Integer;
begin
Result := 0;
for i := 1 to Length(Value) do
begin
Result := (Result shl 4) + Ord(Value[i]);
x := Result and $F0000000;
if (x <> 0) then
Result := Result xor (x shr 24);
Result := Result and (not x);
end;
end;
program SpeedTest;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Winapi.Windows,
System.Generics.Defaults,
System.Generics.Collections,
System.SysUtils,
System.Classes;
type
TStringEqualComparer = class(TInterfacedObject)
function Equals(const Left, Right: string): Boolean; reintroduce;
// важно! если сделать виртуальный метод - то скорость падает ~3 раза
// function GetHashCode(const Value: string): Integer; reintroduce; virtual; abstract;
end;
TComparerClass = class of TStringEqualComparer;
TSedgwicComparer = class(TStringEqualComparer, IEqualityComparer<string>)
function GetHashCode(const Value: string): Integer; reintroduce;
end;
TShaPerfectComparer = class(TStringEqualComparer, IEqualityComparer<string>)
function GetHashCode(const Value: string): Integer; reintroduce;
end;
TFastComparer = class(TStringEqualComparer, IEqualityComparer<string>)
function GetHashCode(const Value: string): Integer; reintroduce;
end;
{ TStringEqualComparer }
function TStringEqualComparer.Equals(const Left, Right: string): Boolean;
label
cmp_ptrs;
var
i, Count: NativeInt;
S1, S2: PNativeUInt;
begin
S1 := Pointer(Left);
S2 := Pointer(Right);
if (S1 <> S2) and (S1 <> nil) and (S2 <> nil) then
begin
Dec(NativeUInt(S1), SizeOf(Integer));
Dec(NativeUInt(S2), SizeOf(Integer));
Count := PInteger(S1)^;
if (Integer(Count) <> PInteger(S2)^) then goto cmp_ptrs;
Inc(NativeUInt(S1), SizeOf(Integer));
Inc(NativeUInt(S2), SizeOf(Integer));
for i := 1 to Count shr {$if SizeOf(NativeUInt) = 8}2{$else}1{$endif} do
begin
if (S1^ <> S2^) then goto cmp_ptrs;
Inc(S1);
Inc(S2);
end;
{$if SizeOf(NativeUInt) = 8}
if (Count and 2 <> 0) then
begin
if (PCardinal(S1)^ <> PCardinal(S2)^) then goto cmp_ptrs;
Inc(NativeUInt(S1), SizeOf(Cardinal));
Inc(NativeUInt(S2), SizeOf(Cardinal));
end;
{$endif}
if (PWord(S1)^ <> PWord(S2)^) then goto cmp_ptrs;
Result := True;
Exit;
end else
begin
cmp_ptrs:
Result := (S1 = S2);
end;
end;
{ TSedgwicComparer }
function TSedgwicComparer.GetHashCode(const Value: string): Integer;
var
a, i: Integer;
begin
Result := 0;
a := 63689;
for i := 0 to Length(Value) - 1 do
begin
Result := Result * a + PWordArray(Value)[i];
a := a * 378551;
end;
end;
{ TShaPerfectComparer }
function TShaPerfectComparer.GetHashCode(const Value: string): Integer;
var
i, j: integer;
begin;
Result:=0;
for i:=0 to Length(Value)-1 do begin;
j:=ord(Value[i+1]);
Result:=Result * 1041204193 + (j+1507220783);
end;
Result:=Result * -1866451833;
end;
{ TFastComparer }
function TFastComparer.GetHashCode(const Value: string): Integer;
var
i, X, Count: Integer;
S: PByte;
begin
S := Pointer(Value);
Result := 0;
if (S <> nil) then
begin
Count := PInteger(NativeInt(Value) - 4)^;
Result := Count;
for i := 1 to (Count shr 1) do
begin
X := Result xor PInteger(S)^;
Result := Result * i;
Inc(Result, X shr 16);
Inc(S, SizeOf(Integer));
Inc(Result, X);
end;
Inc(Result, Ord(PChar(S)^));
Result := Result * -1866451833;
end;
end;
const
ITERATIONS_COUNT = 100;
COMPARERS: array[0..2] of TComparerClass = (TSedgwicComparer, TShaPerfectComparer, TFastComparer);
var
i, c, k: NativeInt;
VALUES: TArray<string>;
List: TStringList;
Time: Cardinal;
Comparer: IEqualityComparer<string>;
Dictionary: TDictionary<string, Integer>;
begin
try
// загрузка значений
List := TStringList.Create;
try
List.LoadFromFile('StringBase.txt');
SetLength(VALUES, List.Count);
for i := 0 to List.Count - 1 do
begin
VALUES[i] := List[i];
end;
finally
List.Free;
end;
// цикл по всем компарерам
for c := Low(COMPARERS) to High(COMPARERS) do
begin
// компарер, конструктор
Write(COMPARERS[c].ClassName, '...');
case c of
0: Comparer := TSedgwicComparer.Create;
1: Comparer := TShaPerfectComparer.Create;
else
// 2:
Comparer := TFastComparer.Create;
end;
Dictionary := TDictionary<string, Integer>.Create(Length(VALUES), Comparer);
try
// заполняем
for k := Low(VALUES) to High(VALUES) do
Dictionary.Add(VALUES[k], 0);
// тестируем
Time := GetTickCount;
for i := 1 to ITERATIONS_COUNT do
for k := Low(VALUES) to High(VALUES) do
begin
Dictionary.Items[VALUES[k]];
end;
Time := GetTickCount - Time;
Writeln(' ', Time, 'мс');
finally
Comparer := nil;
Dictionary.Free;
end;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
// нажать Enter
Writeln;
Write('Press Enter');
Readln;
end.
1 program HashTest; 2 3 {$APPTYPE CONSOLE} 4 5 {$R *.res} 6 7 uses 8 Winapi.Windows, 9 System.SysUtils, 10 System.Classes, 11 System.Generics.Collections, 12 System.Generics.Defaults; 13 14 type 15 TStringEqualComparer = class(TInterfacedObject) 16 function Equals(const Left, Right: string): Boolean; reintroduce; 17 // важно! если сделать виртуальный метод - то скорость падает ~3 раза 18 // function GetHashCode(const Value: string): Integer; reintroduce; virtual; abstract; 19 end; 20 21 TSedgwicComparer = class(TStringEqualComparer, IEqualityComparer<string>) 22 function GetHashCode(const Value: string): Integer; reintroduce; 23 end; 24 25 TSimpleComparer = class(TStringEqualComparer, IEqualityComparer<string>) 26 function GetHashCode(const Value: string): Integer; reintroduce; 27 end; 28 29 TShiftComparer = class(TStringEqualComparer, IEqualityComparer<string>) 30 function GetHashCode(const Value: string): Integer; reintroduce; 31 end; 32 33 TFastComparer = class(TStringEqualComparer, IEqualityComparer<string>) 34 function GetHashCode(const Value: string): Integer; reintroduce; 35 end; 36 37 TMurmur3Comparer = class(TStringEqualComparer, IEqualityComparer<string>) 38 function GetHashCode(const Value: string): Integer; reintroduce; 39 end; 40 41 { TStringEqualComparer } 42 43 function TStringEqualComparer.Equals(const Left, Right: string): Boolean; 44 label 45 cmp_ptrs; 46 var 47 i, Count: NativeInt; 48 S1, S2: PNativeUInt; 49 begin 50 S1 := Pointer(Left); 51 S2 := Pointer(Right); 52 if (S1 <> S2) and (S1 <> nil) and (S2 <> nil) then 53 begin 54 Dec(NativeUInt(S1), SizeOf(Integer)); 55 Dec(NativeUInt(S2), SizeOf(Integer)); 56 Count := PInteger(S1)^; 57 if (Integer(Count) <> PInteger(S2)^) then goto cmp_ptrs; 58 Inc(NativeUInt(S1), SizeOf(Integer)); 59 Inc(NativeUInt(S2), SizeOf(Integer)); 60 61 for i := 1 to Count shr {$ifdef CPUX64}2{$else}1{$endif} do 62 begin 63 if (S1^ <> S2^) then goto cmp_ptrs; 64 Inc(S1); 65 Inc(S2); 66 end; 67 68 {$ifdef CPUX64} 69 if (Count and 2 <> 0) then 70 begin 71 if (PCardinal(S1)^ <> PCardinal(S2)^) then goto cmp_ptrs; 72 Inc(NativeUInt(S1), SizeOf(Cardinal)); 73 Inc(NativeUInt(S2), SizeOf(Cardinal)); 74 end; 75 {$endif} 76 77 if (PWord(S1)^ <> PWord(S2)^) then goto cmp_ptrs; 78 Result := True; 79 Exit; 80 end else 81 begin 82 cmp_ptrs: 83 Result := (S1 = S2); 84 end; 85 end; 86 87 { TSedgwicComparer } 88 89 function TSedgwicComparer.GetHashCode(const Value: string): Integer; 90 var 91 a, i: Integer; 92 begin 93 Result := 0; 94 a := 63689; 95 for i := 1 to Length(Value) - 1 do 96 begin 97 Result := Result * a + PWordArray(Value)[i]; 98 a := a * 378551; 99 end; 100 end; 101 102 { TSimpleComparer } 103 104 function TSimpleComparer.GetHashCode(const Value: string): Integer; 105 var 106 i: NativeInt; 107 S: PChar; 108 begin 109 S := Pointer(Value); 110 Result := 0; 111 if (S <> nil) then 112 begin 113 Result := PInteger(NativeInt(Value) - 4)^; 114 115 for i := 0 to NativeInt(Result) - 1 do 116 begin 117 Result := Result + Ord(S[i]); 118 end; 119 end; 120 end; 121 122 { TShiftComparer } 123 124 function TShiftComparer.GetHashCode(const Value: string): Integer; 125 var 126 i: NativeInt; 127 S: PChar; 128 begin 129 S := Pointer(Value); 130 Result := 0; 131 if (S <> nil) then 132 begin 133 Result := PInteger(NativeInt(Value) - 4)^; 134 135 for i := 0 to NativeInt(Result) - 1 do 136 begin 137 Result := Result xor (Result shr (i and 7 + 1)) + Ord(S[i]); 138 end; 139 end; 140 end; 141 142 { TFastComparer } 143 144 function TFastComparer.GetHashCode(const Value: string): Integer; 145 var 146 i, X, Count: Integer; 147 S: PByte; 148 begin 149 S := Pointer(Value); 150 Result := 0; 151 if (S <> nil) then 152 begin 153 Count := PInteger(NativeInt(Value) - 4)^; 154 155 Result := Count; 156 for i := 1 to (Count shr (SizeOf(Char) xor 3)) do 157 begin 158 X := Result xor PInteger(S)^; 159 Result := Result * i; 160 Inc(Result, X shr 19); 161 Inc(S, SizeOf(Integer)); 162 Inc(Result, X); 163 end; 164 165 for i := 1 to (Count and ((SizeOf(Char) xor 2) or 1)) do 166 begin 167 Result := Result * i; 168 Inc(Result, Ord(PChar(S)^)); 169 Inc(S, SizeOf(Char)); 170 end; 171 end; 172 end; 173 174 { TMurmur3Comparer } 175 176 type 177 uint32_t = cardinal; 178 {$IFNDEF fpc} 179 function RolDWord(x:uint32_t;r:integer):uint32_t; 180 {$IF Defined(CPUX86)} 181 asm 182 MOV CL, DL 183 ROL EAX, CL 184 end; 185 {$ELSEIF Defined(CPUX64)} 186 asm 187 MOV EAX, ECX 188 MOV CL, DL 189 ROL EAX, CL 190 end; 191 {$ELSE} 192 begin 193 Result:=(x shl r) or (x shr (32 - r)); 194 end; 195 {$IFEND} 196 {$ENDIF} 197 198 function MurmurHash3_x86_32 ( const Akey; len:uint32_t): cardinal; 199 type 200 Puint32_t=^uint32_t; 201 202 var data:Puint32_t; 203 nblocks,tail_len,i:uint32_t; 204 h1,k1:uint32_t; 205 const 206 c1:uint32_t = $cc9e2d51; 207 c2:uint32_t = $1b873593; 208 type 209 TTailRec=packed record 210 case Integer of 211 1:(b:byte); 212 2:(w:word); 213 3:(uint24_d:uint32_t); 214 end; 215 var 216 tail:^TTailRec; 217 begin 218 data := @Akey; 219 nblocks := len div 4; 220 221 h1 := 0; 222 //---------- 223 // body 224 for i:=1 to nblocks do begin 225 k1 := data^; 226 227 k1 := k1 * c1; 228 k1 := RolDWord(k1,15); 229 k1 := k1*c2; 230 231 h1 := h1 xor k1; 232 h1 := RolDWord(h1,13); 233 h1 := h1*5+$e6546b64; 234 235 inc(data); 236 end; 237 238 //---------- 239 // tail 240 241 tail :=pointer(data); 242 243 k1 := 0; 244 tail_len:=len and 3; 245 if tail_len>0 then begin 246 case tail_len of 247 3: k1 :=k1 xor (tail^.uint24_d and $FFFFFF); 248 2: k1 :=k1 xor tail^.w; 249 1: k1 :=k1 xor tail^.b; 250 end; 251 252 k1 :=k1* c1; 253 k1 := RolDWord(k1,15); 254 k1 :=k1 * c2; 255 h1 :=h1 xor k1; 256 end; 257 //---------- 258 // finalization 259 260 h1 :=h1 xor len; 261 262 //h1 := fmix32(h1); Result := h1; 263 264 h1 :=h1 xor (h1 shr 16); 265 h1 :=h1* $85ebca6b; 266 h1 :=h1 xor (h1 shr 13); 267 h1 :=h1 * $c2b2ae35; 268 269 Result:=h1 xor (h1 shr 16); 270 end; 271 function TMurmur3Comparer.GetHashCode(const Value: string): Integer; 272 begin 273 Result := Integer(MurmurHash3_x86_32(PChar(Value)^, Length(Value) * SizeOf(Char))); 274 end; 275 276 277 278 procedure TestDict(Title: string; L: TStringList; C: IEqualityComparer<string> = nil); 279 var 280 t1, t2: Cardinal; 281 D: TDictionary<string, Integer>; 282 i: Integer; 283 begin 284 Write(Title); 285 // 286 D := TDictionary<string, Integer>.Create(L.Count, C); 287 try 288 t1 := GetTickCount(); 289 for i := L.Count - 1 downto 0 do 290 D.AddOrSetValue(L[i], i); 291 292 t2 := GetTickCount(); 293 Writeln(t2 - t1); 294 finally 295 D.Free; 296 end; 297 // 298 end; 299 300 function GenStr(): string; 301 var 302 l: Integer; 303 begin 304 l := Random(1024); 305 SetLength(Result, l); 306 for l := l downto 1 do 307 begin 308 Result[l] := Char(Random(256)); 309 end; 310 end; 311 312 procedure GenList(L: TStringList); 313 var 314 i: Integer; 315 begin 316 RandSeed := 0; 317 for i := 1 to 1000000 do 318 L.Add(GenStr) 319 end; 320 321 var 322 L: TStringList; 323 324 begin 325 try 326 L:= TStringList.Create; 327 try 328 GenList(L); 329 TestDict( 'std: ', L); 330 331 TestDict( 'TSedgwicComparer: ', L, TSedgwicComparer.Create); 332 TestDict( 'TMurmur3Comparer: ', L, TMurmur3Comparer.Create); 333 TestDict( 'TFastComparer: ', L, TFastComparer.Create); 334 TestDict( 'TShiftComparer: ', L, TShiftComparer.Create); 335 TestDict( 'TSimpleComparer: ', L, TSimpleComparer.Create); 336 finally 337 L.Free; 338 end; 339 { TODO -oUser -cConsole Main : Insert code here } 340 except 341 on E: Exception do 342 Writeln(E.ClassName, ': ', E.Message); 343 end; 344 end.
program SpeedTest;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Winapi.Windows,
System.Generics.Defaults,
System.Generics.Collections,
System.SysUtils,
System.Classes;
type
TStringEqualComparer = class(TInterfacedObject)
function Equals(const Left, Right: string): Boolean; reintroduce;
// важно! если сделать виртуальный метод - то скорость падает ~3 раза
// function GetHashCode(const Value: string): Integer; reintroduce; virtual; abstract;
end;
TComparerClass = class of TStringEqualComparer;
TSedgwicComparer = class(TStringEqualComparer, IEqualityComparer<string>)
function GetHashCode(const Value: string): Integer; reintroduce;
end;
TSimpleComparer = class(TStringEqualComparer, IEqualityComparer<string>)
function GetHashCode(const Value: string): Integer; reintroduce;
end;
TShiftComparer = class(TStringEqualComparer, IEqualityComparer<string>)
function GetHashCode(const Value: string): Integer; reintroduce;
end;
TFastComparer = class(TStringEqualComparer, IEqualityComparer<string>)
function GetHashCode(const Value: string): Integer; reintroduce;
end;
{ TStringEqualComparer }
function TStringEqualComparer.Equals(const Left, Right: string): Boolean;
label
cmp_ptrs;
var
i, Count: NativeInt;
S1, S2: PNativeUInt;
begin
S1 := Pointer(Left);
S2 := Pointer(Right);
if (S1 <> S2) and (S1 <> nil) and (S2 <> nil) then
begin
Dec(NativeUInt(S1), SizeOf(Integer));
Dec(NativeUInt(S2), SizeOf(Integer));
Count := PInteger(S1)^;
if (Integer(Count) <> PInteger(S2)^) then goto cmp_ptrs;
Inc(NativeUInt(S1), SizeOf(Integer));
Inc(NativeUInt(S2), SizeOf(Integer));
for i := 1 to Count shr {$if SizeOf(NativeUInt) = 8}2{$else}1{$endif} do
begin
if (S1^ <> S2^) then goto cmp_ptrs;
Inc(S1);
Inc(S2);
end;
{$if SizeOf(NativeUInt) = 8}
if (Count and 2 <> 0) then
begin
if (PCardinal(S1)^ <> PCardinal(S2)^) then goto cmp_ptrs;
Inc(NativeUInt(S1), SizeOf(Cardinal));
Inc(NativeUInt(S2), SizeOf(Cardinal));
end;
{$endif}
if (PWord(S1)^ <> PWord(S2)^) then goto cmp_ptrs;
Result := True;
Exit;
end else
begin
cmp_ptrs:
Result := (S1 = S2);
end;
end;
{ TSedgwicComparer }
function TSedgwicComparer.GetHashCode(const Value: string): Integer;
var
a, i: Integer;
begin
Result := 0;
a := 63689;
for i := 1 to Length(Value) - 1 do
begin
Result := Result * a + PWordArray(Value)[i];
a := a * 378551;
end;
end;
{ TSimpleComparer }
function TSimpleComparer.GetHashCode(const Value: string): Integer;
var
i: NativeInt;
S: PChar;
begin
S := Pointer(Value);
Result := 0;
if (S <> nil) then
begin
Result := PInteger(NativeInt(Value) - 4)^;
for i := 0 to NativeInt(Result) - 1 do
begin
Result := Result + Ord(S[i]);
end;
end;
end;
{ TShiftComparer }
function TShiftComparer.GetHashCode(const Value: string): Integer;
var
i: NativeInt;
S: PChar;
begin
S := Pointer(Value);
Result := 0;
if (S <> nil) then
begin
Result := PInteger(NativeInt(Value) - 4)^;
for i := 0 to NativeInt(Result) - 1 do
begin
Result := Result xor (Result shr (i and 7 + 1)) + Ord(S[i]);
end;
end;
end;
{ TFastComparer }
function TFastComparer.GetHashCode(const Value: string): Integer;
var
i, X, Count: Integer;
S: PByte;
begin
S := Pointer(Value);
Result := 0;
if (S <> nil) then
begin
Count := PInteger(NativeInt(Value) - 4)^;
Result := Count;
for i := 1 to (Count shr (SizeOf(Char) xor 3)) do
begin
X := Result xor PInteger(S)^;
Result := Result * i;
Inc(Result, X shr 19);
Inc(S, SizeOf(Integer));
Inc(Result, X);
end;
for i := 1 to (Count and ((SizeOf(Char) xor 2) or 1)) do
begin
Result := Result * i;
Inc(Result, Ord(PChar(S)^));
Inc(S, SizeOf(Char));
end;
end;
end;
const
ITERATIONS_COUNT = 1000000;
COMPARERS: array[0..4] of TComparerClass = (nil, TSedgwicComparer, TSimpleComparer, TShiftComparer, TFastComparer);
var
i, c, k: NativeInt;
VALUES: TArray<string>;
Time: Cardinal;
Dictionary: TDictionary<string, Integer>;
begin
VALUES := [
'div',
'span',
'table',
'td',
'tr',
'th',
'li',
'meta',
'script',
'style',
'ol',
'ul',
'h1',
'h2',
'h3',
'h4',
'h5',
'thead',
'tbody',
'html',
'body',
'blockquote',
'address',
'frame',
'frameset',
'pre',
'button',
'textarea',
'strike',
'del',
'menu',
'small',
'sub',
'sup',
'img',
'fieldset',
'legend'
];
try
// цикл по всем компарерам
for c := Low(COMPARERS) to High(COMPARERS) do
begin
// конструктор, инфо
if (COMPARERS[c] = nil) then
begin
Write('Default', '...');
Dictionary := TDictionary<string, Integer>.Create;
end else
begin
Write(COMPARERS[c].ClassName, '...');
case c of
1: Dictionary := TDictionary<string, Integer>.Create(TSedgwicComparer.Create);
2: Dictionary := TDictionary<string, Integer>.Create(TSimpleComparer.Create);
3: Dictionary := TDictionary<string, Integer>.Create(TShiftComparer.Create);
else
// 4:
Dictionary := TDictionary<string, Integer>.Create(TFastComparer.Create);
end;
end;
try
// заполняем
for k := Low(VALUES) to High(VALUES) do
Dictionary.Add(VALUES[k], 0);
// тестируем
Time := GetTickCount;
for i := 1 to ITERATIONS_COUNT do
for k := Low(VALUES) to High(VALUES) do
begin
Dictionary.Items[VALUES[k]];
end;
Time := GetTickCount - Time;
Writeln(' ', Time, 'мс');
finally
Dictionary.Free;
end;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
// нажать Enter
Writeln;
Write('Press Enter');
Readln;
end.
function StringHash(const Value: string): Integer;
var
i: Integer;
S: PChar;
begin
S := Pointer(Value);
Result := 0;
if (S <> nil) then
begin
Result := PInteger(NativeInt(Value) - 4)^;
for i := 1 to Result do
begin
Result := Result * i + Ord(S^);
Inc(S);
end;
end;
end;
program Hash; {$APPTYPE CONSOLE} {$R *.res} uses Winapi.Windows, System.Generics.Collections, System.SysUtils, System.Classes; const KEYS_COUNT = 1000000; var i: NativeInt; HashValue: Integer; Keys: TArray<string>; Dictionary: TDictionary<Integer, Integer>; function StringHash(const Value: string): Integer; var i, X, Count: Integer; S: PByte; begin S := Pointer(Value); Result := 0; if (S <> nil) then begin Count := PInteger(NativeInt(Value) - 4)^; Result := Count; for i := 1 to (Count shr (SizeOf(Char) xor 3)) do begin X := Result xor PInteger(S)^; Result := Result * i; Inc(Result, X shr 19); Inc(S, SizeOf(Integer)); Inc(Result, X); end; for i := 1 to (Count and ((SizeOf(Char) xor 2) or 1)) do begin Result := Result * i; Inc(Result, Ord(PChar(S)^)); Inc(S, SizeOf(Char)); end; end; end; function GetHash(const Key: string): Integer; var a: Integer; i: Integer; begin Result := 0; a := 63689; for i := 1 to Length(Key) - 1 do begin Result := Result * a + PWordArray(Key)[i]; a := a * 378551; end; end; begin try // заполнение SetLength(Keys, KEYS_COUNT); for i := Low(Keys) to High(Keys) do Keys[i] := TGuid.NewGuid.ToString; // уникальные Dictionary := TDictionary<Integer, Integer>.Create; try for i := Low(Keys) to High(Keys) do begin HashValue := StringHash{GetHash}(Keys[i]) and (1024 * 1024 - 1); Dictionary.AddOrSetValue(HashValue, 0); end; Writeln('Уникальных: ', Dictionary.Count, ', коллизий: ', KEYS_COUNT - Dictionary.Count); finally Dictionary.Free end; // нажать Enter Write('Press Enter'); Readln; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.
function StringHash(const Value: string): Integer; var i, X, Count: Integer; S: PByte; begin S := Pointer(Value); Result := 0; if (S <> nil) then begin Count := PInteger(NativeInt(Value) - 4)^; Result := Count; for i := 1 to (Count shr (SizeOf(Char) xor 3)) do begin X := Result xor PInteger(S)^; Result := Result * i; Inc(Result, X shr 19); Inc(S, SizeOf(Integer)); Inc(Result, X); end; for i := 1 to (Count and ((SizeOf(Char) xor 2) or 1)) do begin Result := Result * i; Inc(Result, Ord(PChar(S)^)); Inc(S, SizeOf(Char)); end; end; end;
type TStringComparer = Class(TEqualityComparer<String>) function Equals(const Left, Right: String): Boolean; Override; function GetHashCode(const Value: String): Integer;Override; End; { TStringComparer } function TStringComparer.Equals(const Left, Right: String): Boolean; begin result := Left = Right; end; function TStringComparer.GetHashCode(const Value: String): Integer; begin result := StringHash(value); end;
{$OverFlowChecks OFF} function GetHash(const Key: String): integer; var a : Integer; i : Integer; begin Result:=0; a:=63689; for i:=1 To Length(Key)-1 do begin Result:=Result*a+PWordArray(Key)[i]; a:=a*378551; end; end;
function StringHash(const Value: string): Integer; var i: NativeInt; S: PChar; begin S := Pointer(Value); Result := 0; if (S <> nil) then begin Result := PInteger(NativeInt(Value) - 4)^; for i := 0 to NativeInt(Result) - 1 do begin Result := Result + Ord(S[i]); end; end; end;
function StringHash(const Value: string): Integer; var i: NativeInt; S: PChar; begin S := Pointer(Value); Result := 0; if (S <> nil) then begin Result := PInteger(NativeInt(Value) - 4)^; for i := 0 to NativeInt(Result) - 1 do begin Result := Result xor (Result shr (i and 7)) + Ord(S[i]); end; end; end;
{$OverFlowChecks OFF} function GetHash(const Key: String): integer; var a : Integer; i : Integer; begin Result:=0; a:=63689; for i:=1 To Length(Key)-1 do begin Result:=Result*a+PWordArray(Key)[i]; a:=a*378551; end; end;
program Test; {$APPTYPE CONSOLE} {$R *.res} uses Winapi.Windows, System.Generics.Collections, System.SysUtils, System.Classes; const ITERATIONS_COUNT = 1000000 div 10; var i, k: NativeInt; VALUES: TArray<string>; Time: Cardinal; StringList: TStringList; Dictionary: TDictionary<string, Integer>; type THtmlTag = (tagUnknown, tagAddress, tagBlockquote, tagBody, tagButton, tagDel, tagDiv, tagFieldset, tagFrame, tagFrameset, tagH1, tagH2, tagH3, tagH4, tagH5, tagHtml, tagImg, tagLegend, tagLi, tagMenu, tagMeta, tagOl, tagPre, tagScript, tagSmall, tagSpan, tagStrike, tagStyle, tagSub, tagSup, tagTable, tagTbody, tagTd, tagTextarea, tagTh, tagThead, tagTr, tagUl); function StrToHtmlTag(const S: UnicodeString): THtmlTag; type HugeByteArray = array[0..High(Integer) div SizeOf(Byte) - 1] of Byte; HugeWordArray = array[0..High(Integer) div SizeOf(Word) - 1] of Word; HugeCardinalArray = array[0..High(Integer) div SizeOf(Cardinal) - 1] of Cardinal; HugeNativeUIntArray = array[0..High(Integer) div SizeOf(NativeUInt) - 1] of NativeUInt; PMemoryItems = ^TMemoryItems; TMemoryItems = packed record case Integer of 0: (Bytes: HugeByteArray); 1: (Words: HugeWordArray); 2: (Cardinals: HugeCardinalArray); 3: (NativeUInts: HugeNativeUIntArray); 4: (A1: array[1..1] of Byte; case Integer of 0: (Words1: HugeWordArray); 1: (Cardinals1: HugeCardinalArray); 2: (NativeUInts1: HugeNativeUIntArray); ); 5: (A2: array[1..2] of Byte; case Integer of 0: (Cardinals2: HugeCardinalArray); 1: (NativeUInts2: HugeNativeUIntArray); ); 6: (A3: array[1..3] of Byte; case Integer of 0: (Cardinals3: HugeCardinalArray); 1: (NativeUInts3: HugeNativeUIntArray); ); end; var Len: Integer; begin // default value Result := tagUnknown; if (Pointer(S) = nil) then Exit; Len := PInteger(NativeInt(S) - 4)^; // utf16 ascii with PMemoryItems(S)^ do if (Len >= 2) then case (Words[0]) of // "address", "blockquote", "body", "button", "del", "div", ... $0061: if (Len = 7) and (Cardinals2[0] = $00640064) and (Cardinals2[1] = $00650072) and (Cardinals2[2] = $00730073) then Result := tagAddress; // "address" $0062: case Len of // "body", "button", "blockquote" 4: if (Cardinals2[0] = $0064006F) and (Words[3] = $0079) then Result := tagBody; // "body" 6: if (Cardinals2[0] = $00740075) and (Cardinals2[1] = $006F0074) and (Words[5] = $006E) then Result := tagButton; // "button" 10: if (Cardinals2[0] = $006F006C) and (Cardinals2[1] = $006B0063) and (Cardinals2[2] = $00750071) and (Cardinals2[3] = $0074006F) and (Words[9] = $0065) then Result := tagBlockquote; // "blockquote" end; $0064: if (Len = 3) then case (Cardinals2[0]) of // "del", "div" $006C0065: Result := tagDel; // "del" $00760069: Result := tagDiv; // "div" end; $0066: case Len of // "frame", "fieldset", "frameset" 5: if (Cardinals2[0] = $00610072) and (Cardinals2[1] = $0065006D) then Result := tagFrame; // "frame" 8: case (Cardinals2[0]) of // "fieldset", "frameset" $00650069: if (Cardinals2[1] = $0064006C) and (Cardinals2[2] = $00650073) and (Words[7] = $0074) then Result := tagFieldset; // "fieldset" $00610072: if (Cardinals2[1] = $0065006D) and (Cardinals2[2] = $00650073) and (Words[7] = $0074) then Result := tagFrameset; // "frameset" end; end; $0068: case Len of // "h1", "h2", "h3", "h4", "h5", "html" 2: case (Words[1]) of // "h1", "h2", "h3", "h4", "h5" $0031: Result := tagH1; // "h1" $0032: Result := tagH2; // "h2" $0033: Result := tagH3; // "h3" $0034: Result := tagH4; // "h4" $0035: Result := tagH5; // "h5" end; 4: if (Cardinals2[0] = $006D0074) and (Words[3] = $006C) then Result := tagHtml; // "html" end; $0069: if (Len = 3) and (Cardinals2[0] = $0067006D) then Result := tagImg; // "img" $006C: case Len of // "li", "legend" 2: if (Words[1] = $0069) then Result := tagLi; // "li" 6: if (Cardinals2[0] = $00670065) and (Cardinals2[1] = $006E0065) and (Words[5] = $0064) then Result := tagLegend; // "legend" end; $006D: if (Len = 4) then if (Words[1] = $0065) then case (Cardinals[1]) of // "menu", "meta" $0075006E: Result := tagMenu; // "menu" $00610074: Result := tagMeta; // "meta" end; $006F: if (Len = 2) and (Words[1] = $006C) then Result := tagOl; // "ol" $0070: if (Len = 3) and (Cardinals2[0] = $00650072) then Result := tagPre; // "pre" $0073: case Len of // "sub", "sup", "span", "small", "style", "script", "strike" 3: if (Words[1] = $0075) then case (Words[2]) of // "sub", "sup" $0062: Result := tagSub; // "sub" $0070: Result := tagSup; // "sup" end; 4: if (Cardinals2[0] = $00610070) and (Words[3] = $006E) then Result := tagSpan; // "span" 5: case (Cardinals2[0]) of // "small", "style" $0061006D: if (Cardinals2[1] = $006C006C) then Result := tagSmall; // "small" $00790074: if (Cardinals2[1] = $0065006C) then Result := tagStyle; // "style" end; 6: case (Cardinals2[0]) of // "script", "strike" $00720063: if (Cardinals2[1] = $00700069) and (Words[5] = $0074) then Result := tagScript; // "script" $00720074: if (Cardinals2[1] = $006B0069) and (Words[5] = $0065) then Result := tagStrike; // "strike" end; end; $0074: case Len of // "td", "th", "tr", "table", "tbody", "thead", "textarea" 2: case (Words[1]) of // "td", "th", "tr" $0064: Result := tagTd; // "td" $0068: Result := tagTh; // "th" $0072: Result := tagTr; // "tr" end; 5: case (Cardinals2[0]) of // "table", "tbody", "thead" $00620061: if (Cardinals2[1] = $0065006C) then Result := tagTable; // "table" $006F0062: if (Cardinals2[1] = $00790064) then Result := tagTbody; // "tbody" $00650068: if (Cardinals2[1] = $00640061) then Result := tagThead; // "thead" end; 8: if (Cardinals2[0] = $00780065) and (Cardinals2[1] = $00610074) and (Cardinals2[2] = $00650072) and (Words[7] = $0061) then Result := tagTextarea; // "textarea" end; $0075: if (Len = 2) and (Words[1] = $006C) then Result := tagUl; // "ul" end; end; begin VALUES := [ 'div', 'span', 'table', 'td', 'tr', 'th', 'li', 'meta', 'script', 'style', 'ol', 'ul', 'h1', 'h2', 'h3', 'h4', 'h5', 'thead', 'tbody', 'html', 'body', 'blockquote', 'address', 'frame', 'frameset', 'pre', 'button', 'textarea', 'strike', 'del', 'menu', 'small', 'sub', 'sup', 'img', 'fieldset', 'legend' ]; try // бинарный поиск begin Write('Бинарный поиск(TStringList)...'); StringList := TStringList.Create; try for k := Low(VALUES) to High(VALUES) do StringList.Add(VALUES[k]); StringList.Sorted := True; Time := GetTickCount; for i := 1 to ITERATIONS_COUNT do for k := Low(VALUES) to High(VALUES) do begin StringList.IndexOf(VALUES[k]); end; Time := GetTickCount - Time; Writeln(' ', Time, 'мс'); finally StringList.Free; end; end; // хеш begin Write('Хеш поиск(Dictionary)...'); Dictionary := TDictionary<string, Integer>.Create; try for k := Low(VALUES) to High(VALUES) do Dictionary.Add(VALUES[k], 0); Time := GetTickCount; for i := 1 to ITERATIONS_COUNT do for k := Low(VALUES) to High(VALUES) do begin Dictionary.Items[VALUES[k]]; end; Time := GetTickCount - Time; Writeln(' ', Time, 'мс'); finally Dictionary.Free; end; end; // кодогенерация begin Write('Кодогенерация(CachedSerializer)...'); Time := GetTickCount; for i := 1 to ITERATIONS_COUNT do for k := Low(VALUES) to High(VALUES) do begin StrToHtmlTag(VALUES[k]); end; Time := GetTickCount - Time; Writeln(' ', Time, 'мс'); end; // нажать Enter Writeln; Write('Press Enter'); Readln; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.
function StringHash(const Value: string): Integer; var i: NativeInt; S: PChar; begin S := Pointer(Value); Result := 0; if (S <> nil) then begin Result := PInteger(NativeInt(Value) - 4)^; for i := 0 to NativeInt(Result) - 1 do begin Result := Result xor (Result shr (i and 7 + 1)) + Ord(S[i]); end; end; end;
procedure TForm23.Button1Click(Sender: TObject); var i, k, T: integer; L: TStringList; s: string; D: TDictionary<string, TObject>; //ST: THtStringTrie; O: TObject; begin L:=TStringList.Create; L.Add('div'); L.Add('span'); L.Add('table'); L.Add('td'); L.Add('tr'); L.Add('th'); L.Add('li'); L.Add('meta'); L.Add('script'); L.Add('style'); L.Add('ol'); L.Add('ul'); L.Add('h1'); L.Add('h2'); L.Add('h3'); L.Add('h4'); L.Add('h5'); L.Add('thead'); L.Add('tbody'); L.Add('html'); L.Add('body'); L.Add('blockquote'); L.Add('address'); L.Add('frame'); L.Add('frameset'); L.Add('pre'); L.Add('button'); L.Add('textarea'); L.Add('strike'); L.Add('del'); L.Add('menu'); L.Add('small'); L.Add('sub'); L.Add('sup'); L.Add('img'); L.Add('fieldset'); L.Add('legend'); D := TDictionary<string, TObject>.Create; for i := 0 to L.Count - 1 do D.Add(L[i], TObject.Create); //ST := THtStringTrie.Create(); //for i := 0 to L.Count - 1 do // ST.Add(L[i], TObject.Create); T := GetTickCount; for i := 1 to 1000000 do begin for k := 0 to L.Count -1 do D.TryGetValue(L[k], O) //ST.Find(L[k], O); end; Caption := inttostr(GetTickCount - T); end;
{$OverFlowChecks OFF} function GetHash(const Key: String): integer; var a : Integer; i : Integer; begin Result:=0; a:=63689; for i:=1 To Length(Key)-1 do begin Result:=Result*a+PWordArray(Key)[i]; a:=a*378551; end; end;
function CalcStrCRC32(const s: string): cardinal; var p: pchar; begin Result := $FFFFFFFF; p := pointer(s); if p <> nil then while p^ <> #0 do begin Result := (((Result shr 8) and $00FFFFFF) xor (Ccitt32Table[(Result xor byte(p^)) and $FF])); inc(p); end; end;
procedure TMain.Button3Click(Sender: TObject); const CRC32_POLYNOMIAL = $EDB88320; var i, k, T : integer; L : TStringList; Ccitt32Table : array[0..255] of longint; function crc32(crc : longint; const c : byte) : longint; begin crc32 := (((crc shr 8) and $00FFFFFF) xor (Ccitt32Table[(crc xor c) and $FF])); end; procedure BuildCRCTable; var i, j, value : DWORD; begin for i := 0 to 255 do begin value := i; for j := 8 downto 1 do begin if ((value and 1) <> 0) then value := (value shr 1) xor CRC32_POLYNOMIAL else value := value shr 1; end; Ccitt32Table[i] := value; end end; function GetHash1(const Key: String): integer; var p: pchar; begin Result := $FFFFFFFF; p := pointer(Key); if p <> nil then while p^ <> #0 do begin Result := (((Result shr 8) and $00FFFFFF) xor (Ccitt32Table[(Result xor byte(p^)) and $FF])); inc(p); end; end; {$OverFlowChecks OFF} function GetHash2(const Key: String): integer; var a : Integer; i : Integer; begin Result:=0; a:=63689; for i:=1 To Length(Key)-1 do begin Result:=Result*a+PWordArray(Key)[i]; a:=a*378551; end; end; {$OverFlowChecks On} begin BuildCRCTable; L:=TStringList.Create; L.Add('div'); L.Add('span'); L.Add('table'); L.Add('td'); L.Add('tr'); L.Add('th'); L.Add('li'); L.Add('meta'); L.Add('script'); L.Add('style'); L.Add('ol'); L.Add('ul'); L.Add('h1'); L.Add('h2'); L.Add('h3'); L.Add('h4'); L.Add('h5'); L.Add('thead'); L.Add('tbody'); L.Add('html'); L.Add('body'); L.Add('blockquote'); L.Add('address'); L.Add('frame'); L.Add('frameset'); L.Add('pre'); L.Add('button'); L.Add('textarea'); L.Add('strike'); L.Add('del'); L.Add('menu'); L.Add('small'); L.Add('sub'); L.Add('sup'); L.Add('img'); L.Add('fieldset'); L.Add('legend'); T := GetTickCount; for i := 1 to 1000000 do begin for k := 0 to L.Count -1 do GetHash1(L[k]); end; Edit1.Text := inttostr(GetTickCount - T); T := GetTickCount; for i := 1 to 1000000 do begin for k := 0 to L.Count -1 do GetHash2(L[k]); end; Edit2.Text := inttostr(GetTickCount - T); end;
var stream: TBytesStream; s1: string; s2: string; begin stream := TBytesStream.Create; stream.WriteData(TEncoding.ANSI.GetBytes('test'), 4); s1 := TEncoding.ANSI.GetString(stream.Bytes); // заполнит 8192 символов вместо 4 s2 := TEncoding.ANSI.GetString(stream.Bytes, 0, 4); ShowMessageFmt('stream: %d' + #13#10 + 's1: %d' + #13#10 + 's2: %d', [stream.Size, s1.Length, s2.Length]); FreeAndNil(stream); end;
扫一扫
201
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
