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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE a_modes.inc}
16 {.$DEFINE RBHASH_DEBUG_RESIZE}
17 {.$DEFINE RBHASH_DEBUG_INSERT}
18 {.$DEFINE RBHASH_DEBUG_DELETE}
19 {.$DEFINE RBHASH_DEBUG_COMPACT}
20 {$IF DEFINED(D2F_DEBUG)}
21 {.$DEFINE RBHASH_SANITY_CHECKS}
22 {$ENDIF}
23 // hash table (robin hood)
26 interface
28 (*
29 * HashObjT: class that contains class methods:
30 * class function hash (const[ref] k: KeyT): LongWord;
31 * class function equ (const[ref] a, b: KeyT): Boolean;
32 * class procedure freekey (var k: KeyT); // this may free key
33 *)
34 type
35 // WARNING! don't put structures into hash, use ponters or ids!
37 private
38 const InitSize = {$IF DEFINED(RBHASH_SANITY_CHECKS)}16{$ELSE}256{$ENDIF}; // *MUST* be power of two
41 public
42 type
45 public
48 private
51 private
53 public
59 type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
60 type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
62 private
63 type
66 public
67 type
69 private
72 public
81 private
84 public
93 private
96 public
104 private
109 {$IFDEF RBHASH_SANITY_CHECKS}
111 {$ENDIF}
116 private
128 public
138 // you may pass `keyhash` to bypass hash calculation
139 function get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean; // `true`: found
140 // the function may return calculated value hash in `keyhash`
141 function put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean; // `true`: replaced
142 // you may pass `keyhash` to bypass hash calculation
144 // you may pass `keyhash` to bypass hash calculation
147 //WARNING! don't modify table in iterator (queries are ok, though)
151 // default `for ... in` enums values
161 type
163 private
167 public
175 // current hash value
176 // you can continue putting data, as this is not destructive
181 type
183 public
190 public
196 // case-insensitive (ansi)
198 public
204 type
220 // has to be public due to FPC generics limitation
224 implementation
226 uses
230 // ////////////////////////////////////////////////////////////////////////// //
231 {$PUSH}
232 {$RANGECHECKS OFF}
234 begin
241 // already pot?
242 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
244 {$POP}
247 // ////////////////////////////////////////////////////////////////////////// //
248 {$PUSH}
249 {$RANGECHECKS OFF}
251 begin
256 begin
261 begin
267 var
270 begin
275 begin
286 begin
292 {$POP}
295 // ////////////////////////////////////////////////////////////////////////// //
296 {$PUSH}
297 {$RANGECHECKS OFF}
299 var
302 begin
306 begin
312 // finalize
319 var
322 begin
326 begin
332 // finalize
337 {$POP}
339 {$PUSH}
340 {$RANGECHECKS OFF}
341 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
343 var
345 begin
349 begin
356 {$POP}
358 {$PUSH}
359 {$RANGECHECKS OFF}
361 begin
371 {$POP}
374 begin
376 begin
378 end
379 else
380 begin
382 begin
384 end
385 else
386 begin
397 // ////////////////////////////////////////////////////////////////////////// //
398 // THashKeyInt
400 begin
411 class function THashKeyInt.equ (const a, b: Integer): Boolean; inline; begin result := (a = b); end;
415 // ////////////////////////////////////////////////////////////////////////// //
416 // THashKeyStr
417 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;
418 class function THashKeyStr.equ (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
422 // ////////////////////////////////////////////////////////////////////////// //
423 // case-insensitive (ansi)
424 {$PUSH}
425 {$RANGECHECKS OFF}
426 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
428 var
430 begin
434 begin
441 {$POP}
443 class function THashKeyStrAnsiCI.hash (const k: AnsiString): LongWord; inline; begin if (Length(k) > 0) then result := fnvHashLo((@k[1])^, Length(k)) else result := 0; end;
445 var
447 begin
450 begin
458 // ////////////////////////////////////////////////////////////////////////// //
462 // ////////////////////////////////////////////////////////////////////////// //
467 begin
479 begin
488 var
491 begin
493 begin
495 begin
498 begin
506 end
508 begin
514 {$IFDEF RBHASH_SANITY_CHECKS}
516 {$ENDIF}
521 begin
523 {
524 SetLength(mBuckets, InitSize);
525 FillChar(mBuckets[0], InitSize*sizeof(mBuckets[0]), 0);
526 SetLength(mEntries, InitSize);
527 FillChar(mEntries[0], InitSize*sizeof(mEntries[0]), 0);
528 }
539 //var idx: Integer;
540 begin
543 begin
544 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
552 var
554 begin
556 begin
557 // nothing was allocated, so allocate something now
559 begin
564 {$IFDEF RBHASH_SANITY_CHECKS}
566 {$ENDIF}
572 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
575 begin
576 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
581 {$IFDEF RBHASH_SANITY_CHECKS}
583 {$ENDIF}
584 exit;
586 {$IFDEF RBHASH_SANITY_CHECKS}
587 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
588 if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
589 {$ENDIF}
592 {$IFDEF RBHASH_SANITY_CHECKS}
594 {$ENDIF}
596 // fix mFirstEntry and mLastEntry
598 {$IFDEF RBHASH_SANITY_CHECKS}
599 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
600 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
601 {$ENDIF}
608 var
610 begin
611 {$IFDEF RBHASH_SANITY_CHECKS}
613 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
614 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
615 if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
616 {$ENDIF}
618 {$IFDEF RBHASH_SANITY_CHECKS}
619 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
620 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
621 {$ENDIF}
624 {$IFDEF RBHASH_SANITY_CHECKS}
626 {$ENDIF}
632 // fix mFirstEntry and mLastEntry
633 {$IFDEF RBHASH_SANITY_CHECKS}
634 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
635 {$ENDIF}
637 begin
638 {$IFDEF RBHASH_SANITY_CHECKS}
639 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
640 {$ENDIF}
644 end
645 else
646 begin
647 {$IFDEF RBHASH_SANITY_CHECKS}
648 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
649 {$ENDIF}
650 // fix first entry index
652 begin
655 {$IFDEF RBHASH_SANITY_CHECKS}
656 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
657 {$ENDIF}
660 // fix last entry index
662 begin
665 {$IFDEF RBHASH_SANITY_CHECKS}
666 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
667 {$ENDIF}
675 begin
676 {$IFDEF RBHASH_SANITY_CHECKS}
679 {$ENDIF}
686 var
690 begin
698 begin
701 end
702 else
703 begin
712 begin
723 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
724 var
728 begin
736 begin
739 end
740 else
741 begin
749 begin
763 var
767 begin
771 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
774 begin
776 begin
777 // put entry
781 break;
785 begin
786 // swapping the current bucket with the one to insert
798 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
799 var
804 begin
814 // check if we already have this key
816 begin
818 begin
824 begin
825 // replace element
827 if assigned(freevalfn) then freevalfn(mBuckets[idx].value) else mBuckets[idx].value := Default(ValueT);
830 exit;
836 // need to resize hash?
838 begin
840 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
842 {$IFDEF RBHASH_DEBUG_RESIZE}
843 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
844 {$ENDIF}
846 // resize entries array
850 // mFreeEntryHead will be fixed in `rehash()`
851 // reinsert entries
855 // create new entry
865 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
867 var
870 begin
878 begin
881 end
882 else
883 begin
890 // find key
893 begin
903 begin
904 // key not found
905 {$IFDEF RBHASH_DEBUG_DELETE}
907 {$ENDIF}
908 exit;
911 {$IFDEF RBHASH_DEBUG_DELETE}
912 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
913 {$ENDIF}
918 begin
919 {$IFDEF RBHASH_DEBUG_DELETE}
920 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
921 {$ENDIF}
922 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
924 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
936 var
940 {$IFDEF RBHASH_SANITY_CHECKS}
942 {$ENDIF}
943 begin
944 // change seed, to minimize pathological cases
945 //TODO: use prng to generate new hash
948 // clear buckets
949 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
952 // reinsert entries
956 begin
959 begin
960 {$IFDEF RBHASH_SANITY_CHECKS}
962 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
964 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
965 {$ENDIF}
966 // no need to recalculate hash
968 end
969 else
970 begin
976 {$IFDEF RBHASH_SANITY_CHECKS}
977 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
978 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
979 {$ENDIF}
984 var
986 {$IFDEF RBHASH_SANITY_CHECKS}
988 {$ENDIF}
989 begin
994 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
996 // move all entries to top
998 begin
999 {$IFDEF RBHASH_SANITY_CHECKS}
1000 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
1001 {$ENDIF}
1005 // copy entries
1007 begin
1009 begin
1010 {$IFDEF RBHASH_SANITY_CHECKS}
1012 {$ENDIF}
1021 {$IFDEF RBHASH_SANITY_CHECKS}
1022 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
1023 {$ENDIF}
1026 {$IFDEF RBHASH_SANITY_CHECKS}
1029 begin
1030 if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
1033 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
1034 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
1036 begin
1037 if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
1039 {$ENDIF}
1040 end
1041 else
1042 begin
1043 {$IFDEF RBHASH_SANITY_CHECKS}
1044 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
1045 {$ENDIF}
1047 // shrink
1050 // mFreeEntryHead will be fixed in `rehash()`
1051 // reinsert entries
1057 var
1059 begin
1063 begin
1065 begin
1073 var
1075 begin
1079 begin
1081 begin
1089 // enumerators
1091 begin
1092 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1097 begin
1098 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1103 begin
1104 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1109 begin
1110 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1115 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1116 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1117 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1120 // ////////////////////////////////////////////////////////////////////////// //
1121 constructor THashBase.TValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1122 begin
1130 begin
1133 begin
1140 begin
1145 // ////////////////////////////////////////////////////////////////////////// //
1146 constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1147 begin
1155 begin
1158 begin
1165 begin
1170 // ////////////////////////////////////////////////////////////////////////// //
1171 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1172 begin
1180 begin
1183 begin
1190 begin