1 (* Copyright (C) DooM 2D:Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE a_modes.inc}
17 {.$DEFINE RBHASH_DEBUG_RESIZE}
18 {.$DEFINE RBHASH_DEBUG_INSERT}
19 {.$DEFINE RBHASH_DEBUG_DELETE}
20 {.$DEFINE RBHASH_DEBUG_COMPACT}
21 {$IF DEFINED(D2F_DEBUG)}
22 {.$DEFINE RBHASH_SANITY_CHECKS}
23 {$ENDIF}
24 // hash table (robin hood)
27 interface
29 (*
30 * HashObjT: class that contains class methods:
31 * class function hash (const[ref] k: KeyT): LongWord;
32 * class function equ (const[ref] a, b: KeyT): Boolean;
33 * class procedure freekey (var k: KeyT); // this may free key
34 *)
35 type
36 // WARNING! don't put structures into hash, use ponters or ids!
38 private
39 const InitSize = {$IF DEFINED(RBHASH_SANITY_CHECKS)}16{$ELSE}256{$ENDIF}; // *MUST* be power of two
42 public
43 type
46 public
49 private
52 private
54 public
60 type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
61 type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
63 private
64 type
67 public
68 type
70 private
73 public
82 private
85 public
94 private
97 public
105 private
110 {$IFDEF RBHASH_SANITY_CHECKS}
112 {$ENDIF}
117 private
129 public
139 // you may pass `keyhash` to bypass hash calculation
140 function get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean; // `true`: found
141 // the function may return calculated value hash in `keyhash`
142 function put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean; // `true`: replaced
143 // you may pass `keyhash` to bypass hash calculation
145 // you may pass `keyhash` to bypass hash calculation
148 //WARNING! don't modify table in iterator (queries are ok, though)
152 // default `for ... in` enums values
162 type
164 private
168 public
176 // current hash value
177 // you can continue putting data, as this is not destructive
182 type
184 public
191 public
197 // case-insensitive (ansi)
199 public
205 type
217 // has to be public due to FPC generics limitation
221 implementation
223 uses
227 // ////////////////////////////////////////////////////////////////////////// //
228 {$PUSH}
229 {$RANGECHECKS OFF}
231 begin
238 // already pot?
239 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
241 {$POP}
244 // ////////////////////////////////////////////////////////////////////////// //
245 {$PUSH}
246 {$RANGECHECKS OFF}
248 begin
253 begin
258 begin
264 var
267 begin
272 begin
283 begin
289 {$POP}
292 // ////////////////////////////////////////////////////////////////////////// //
293 {$PUSH}
294 {$RANGECHECKS OFF}
296 var
299 begin
303 begin
309 // finalize
314 {$POP}
316 {$PUSH}
317 {$RANGECHECKS OFF}
318 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
320 var
322 begin
326 begin
333 {$POP}
335 {$PUSH}
336 {$RANGECHECKS OFF}
338 begin
348 {$POP}
351 begin
353 begin
355 end
356 else
357 begin
359 begin
361 end
362 else
363 begin
374 // ////////////////////////////////////////////////////////////////////////// //
375 // THashKeyInt
377 begin
388 class function THashKeyInt.equ (const a, b: Integer): Boolean; inline; begin result := (a = b); end;
392 // ////////////////////////////////////////////////////////////////////////// //
393 // THashKeyStr
394 class function THashKeyStr.hash (const k: AnsiString): LongWord; inline; begin if (Length(k) > 0) then result := fnvHash((@k[1])^, Length(k)) else result := 0; end;
395 class function THashKeyStr.equ (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
399 // ////////////////////////////////////////////////////////////////////////// //
400 // case-insensitive (ansi)
401 {$PUSH}
402 {$RANGECHECKS OFF}
403 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
405 var
407 begin
411 begin
418 {$POP}
420 class function THashKeyStrAnsiCI.hash (const k: AnsiString): LongWord; inline; begin if (Length(k) > 0) then result := fnvHash((@k[1])^, Length(k)) else result := 0; end;
422 var
424 begin
427 begin
435 // ////////////////////////////////////////////////////////////////////////// //
439 // ////////////////////////////////////////////////////////////////////////// //
444 begin
456 begin
465 var
468 begin
470 begin
472 begin
475 begin
483 end
485 begin
491 {$IFDEF RBHASH_SANITY_CHECKS}
493 {$ENDIF}
498 begin
500 {
501 SetLength(mBuckets, InitSize);
502 FillChar(mBuckets[0], InitSize*sizeof(mBuckets[0]), 0);
503 SetLength(mEntries, InitSize);
504 FillChar(mEntries[0], InitSize*sizeof(mEntries[0]), 0);
505 }
516 //var idx: Integer;
517 begin
520 begin
521 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
529 var
531 begin
533 begin
534 // nothing was allocated, so allocate something now
536 begin
541 {$IFDEF RBHASH_SANITY_CHECKS}
543 {$ENDIF}
549 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
552 begin
553 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
558 {$IFDEF RBHASH_SANITY_CHECKS}
560 {$ENDIF}
561 exit;
563 {$IFDEF RBHASH_SANITY_CHECKS}
564 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
565 if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
566 {$ENDIF}
569 {$IFDEF RBHASH_SANITY_CHECKS}
571 {$ENDIF}
573 // fix mFirstEntry and mLastEntry
575 {$IFDEF RBHASH_SANITY_CHECKS}
576 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
577 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
578 {$ENDIF}
585 var
587 begin
588 {$IFDEF RBHASH_SANITY_CHECKS}
590 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
591 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
592 if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
593 {$ENDIF}
595 {$IFDEF RBHASH_SANITY_CHECKS}
596 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
597 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
598 {$ENDIF}
601 {$IFDEF RBHASH_SANITY_CHECKS}
603 {$ENDIF}
609 // fix mFirstEntry and mLastEntry
610 {$IFDEF RBHASH_SANITY_CHECKS}
611 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
612 {$ENDIF}
614 begin
615 {$IFDEF RBHASH_SANITY_CHECKS}
616 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
617 {$ENDIF}
621 end
622 else
623 begin
624 {$IFDEF RBHASH_SANITY_CHECKS}
625 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
626 {$ENDIF}
627 // fix first entry index
629 begin
632 {$IFDEF RBHASH_SANITY_CHECKS}
633 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
634 {$ENDIF}
637 // fix last entry index
639 begin
642 {$IFDEF RBHASH_SANITY_CHECKS}
643 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
644 {$ENDIF}
652 begin
653 {$IFDEF RBHASH_SANITY_CHECKS}
656 {$ENDIF}
663 var
667 begin
675 begin
678 end
679 else
680 begin
689 begin
700 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
701 var
705 begin
713 begin
716 end
717 else
718 begin
726 begin
740 var
744 begin
748 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
751 begin
753 begin
754 // put entry
758 break;
762 begin
763 // swapping the current bucket with the one to insert
775 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
776 var
781 begin
791 // check if we already have this key
793 begin
795 begin
801 begin
802 // replace element
804 if assigned(freevalfn) then freevalfn(mBuckets[idx].value) else mBuckets[idx].value := Default(ValueT);
807 exit;
813 // need to resize hash?
815 begin
817 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
819 {$IFDEF RBHASH_DEBUG_RESIZE}
820 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
821 {$ENDIF}
823 // resize entries array
827 // mFreeEntryHead will be fixed in `rehash()`
828 // reinsert entries
832 // create new entry
842 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
844 var
847 begin
855 begin
858 end
859 else
860 begin
867 // find key
870 begin
880 begin
881 // key not found
882 {$IFDEF RBHASH_DEBUG_DELETE}
884 {$ENDIF}
885 exit;
888 {$IFDEF RBHASH_DEBUG_DELETE}
889 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
890 {$ENDIF}
895 begin
896 {$IFDEF RBHASH_DEBUG_DELETE}
897 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
898 {$ENDIF}
899 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
901 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
913 var
917 {$IFDEF RBHASH_SANITY_CHECKS}
919 {$ENDIF}
920 begin
921 // change seed, to minimize pathological cases
922 //TODO: use prng to generate new hash
925 // clear buckets
926 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
929 // reinsert entries
933 begin
936 begin
937 {$IFDEF RBHASH_SANITY_CHECKS}
939 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
941 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
942 {$ENDIF}
943 // no need to recalculate hash
945 end
946 else
947 begin
953 {$IFDEF RBHASH_SANITY_CHECKS}
954 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
955 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
956 {$ENDIF}
961 var
963 {$IFDEF RBHASH_SANITY_CHECKS}
965 {$ENDIF}
966 begin
971 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
973 // move all entries to top
975 begin
976 {$IFDEF RBHASH_SANITY_CHECKS}
977 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
978 {$ENDIF}
982 // copy entries
984 begin
986 begin
987 {$IFDEF RBHASH_SANITY_CHECKS}
989 {$ENDIF}
998 {$IFDEF RBHASH_SANITY_CHECKS}
999 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
1000 {$ENDIF}
1003 {$IFDEF RBHASH_SANITY_CHECKS}
1006 begin
1007 if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
1010 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
1011 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
1013 begin
1014 if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
1016 {$ENDIF}
1017 end
1018 else
1019 begin
1020 {$IFDEF RBHASH_SANITY_CHECKS}
1021 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
1022 {$ENDIF}
1024 // shrink
1027 // mFreeEntryHead will be fixed in `rehash()`
1028 // reinsert entries
1034 var
1036 begin
1040 begin
1042 begin
1050 var
1052 begin
1056 begin
1058 begin
1066 // enumerators
1068 begin
1069 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1074 begin
1075 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1080 begin
1081 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1086 begin
1087 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1092 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1093 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1094 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1097 // ////////////////////////////////////////////////////////////////////////// //
1098 constructor THashBase.TValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1099 begin
1107 begin
1110 begin
1117 begin
1122 // ////////////////////////////////////////////////////////////////////////// //
1123 constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1124 begin
1132 begin
1135 begin
1142 begin
1147 // ////////////////////////////////////////////////////////////////////////// //
1148 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1149 begin
1157 begin
1160 begin
1167 begin