ec7f54ba85a1b6d86ff9be43b1c63e842fcb7e99
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
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
316 var
319 begin
323 begin
329 // finalize
334 {$POP}
336 {$PUSH}
337 {$RANGECHECKS OFF}
338 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
340 var
342 begin
346 begin
353 {$POP}
355 {$PUSH}
356 {$RANGECHECKS OFF}
358 begin
368 {$POP}
371 begin
373 begin
375 end
376 else
377 begin
379 begin
381 end
382 else
383 begin
394 // ////////////////////////////////////////////////////////////////////////// //
395 // THashKeyInt
397 begin
408 class function THashKeyInt.equ (const a, b: Integer): Boolean; inline; begin result := (a = b); end;
412 // ////////////////////////////////////////////////////////////////////////// //
413 // THashKeyStr
414 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;
415 class function THashKeyStr.equ (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
419 // ////////////////////////////////////////////////////////////////////////// //
420 // case-insensitive (ansi)
421 {$PUSH}
422 {$RANGECHECKS OFF}
423 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
425 var
427 begin
431 begin
438 {$POP}
440 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;
442 var
444 begin
447 begin
455 // ////////////////////////////////////////////////////////////////////////// //
459 // ////////////////////////////////////////////////////////////////////////// //
464 begin
476 begin
485 var
488 begin
490 begin
492 begin
495 begin
503 end
505 begin
511 {$IFDEF RBHASH_SANITY_CHECKS}
513 {$ENDIF}
518 begin
520 {
521 SetLength(mBuckets, InitSize);
522 FillChar(mBuckets[0], InitSize*sizeof(mBuckets[0]), 0);
523 SetLength(mEntries, InitSize);
524 FillChar(mEntries[0], InitSize*sizeof(mEntries[0]), 0);
525 }
536 //var idx: Integer;
537 begin
540 begin
541 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
549 var
551 begin
553 begin
554 // nothing was allocated, so allocate something now
556 begin
561 {$IFDEF RBHASH_SANITY_CHECKS}
563 {$ENDIF}
569 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
572 begin
573 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
578 {$IFDEF RBHASH_SANITY_CHECKS}
580 {$ENDIF}
581 exit;
583 {$IFDEF RBHASH_SANITY_CHECKS}
584 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
585 if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
586 {$ENDIF}
589 {$IFDEF RBHASH_SANITY_CHECKS}
591 {$ENDIF}
593 // fix mFirstEntry and mLastEntry
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 (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
598 {$ENDIF}
605 var
607 begin
608 {$IFDEF RBHASH_SANITY_CHECKS}
610 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
611 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
612 if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
613 {$ENDIF}
615 {$IFDEF RBHASH_SANITY_CHECKS}
616 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
617 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
618 {$ENDIF}
621 {$IFDEF RBHASH_SANITY_CHECKS}
623 {$ENDIF}
629 // fix mFirstEntry and mLastEntry
630 {$IFDEF RBHASH_SANITY_CHECKS}
631 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
632 {$ENDIF}
634 begin
635 {$IFDEF RBHASH_SANITY_CHECKS}
636 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
637 {$ENDIF}
641 end
642 else
643 begin
644 {$IFDEF RBHASH_SANITY_CHECKS}
645 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
646 {$ENDIF}
647 // fix first entry index
649 begin
652 {$IFDEF RBHASH_SANITY_CHECKS}
653 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
654 {$ENDIF}
657 // fix last entry index
659 begin
662 {$IFDEF RBHASH_SANITY_CHECKS}
663 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
664 {$ENDIF}
672 begin
673 {$IFDEF RBHASH_SANITY_CHECKS}
676 {$ENDIF}
683 var
687 begin
695 begin
698 end
699 else
700 begin
709 begin
720 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
721 var
725 begin
733 begin
736 end
737 else
738 begin
746 begin
760 var
764 begin
768 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
771 begin
773 begin
774 // put entry
778 break;
782 begin
783 // swapping the current bucket with the one to insert
795 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
796 var
801 begin
811 // check if we already have this key
813 begin
815 begin
821 begin
822 // replace element
824 if assigned(freevalfn) then freevalfn(mBuckets[idx].value) else mBuckets[idx].value := Default(ValueT);
827 exit;
833 // need to resize hash?
835 begin
837 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
839 {$IFDEF RBHASH_DEBUG_RESIZE}
840 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
841 {$ENDIF}
843 // resize entries array
847 // mFreeEntryHead will be fixed in `rehash()`
848 // reinsert entries
852 // create new entry
862 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
864 var
867 begin
875 begin
878 end
879 else
880 begin
887 // find key
890 begin
900 begin
901 // key not found
902 {$IFDEF RBHASH_DEBUG_DELETE}
904 {$ENDIF}
905 exit;
908 {$IFDEF RBHASH_DEBUG_DELETE}
909 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
910 {$ENDIF}
915 begin
916 {$IFDEF RBHASH_DEBUG_DELETE}
917 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
918 {$ENDIF}
919 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
921 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
933 var
937 {$IFDEF RBHASH_SANITY_CHECKS}
939 {$ENDIF}
940 begin
941 // change seed, to minimize pathological cases
942 //TODO: use prng to generate new hash
945 // clear buckets
946 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
949 // reinsert entries
953 begin
956 begin
957 {$IFDEF RBHASH_SANITY_CHECKS}
959 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
961 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
962 {$ENDIF}
963 // no need to recalculate hash
965 end
966 else
967 begin
973 {$IFDEF RBHASH_SANITY_CHECKS}
974 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
975 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
976 {$ENDIF}
981 var
983 {$IFDEF RBHASH_SANITY_CHECKS}
985 {$ENDIF}
986 begin
991 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
993 // move all entries to top
995 begin
996 {$IFDEF RBHASH_SANITY_CHECKS}
997 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
998 {$ENDIF}
1002 // copy entries
1004 begin
1006 begin
1007 {$IFDEF RBHASH_SANITY_CHECKS}
1009 {$ENDIF}
1018 {$IFDEF RBHASH_SANITY_CHECKS}
1019 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
1020 {$ENDIF}
1023 {$IFDEF RBHASH_SANITY_CHECKS}
1026 begin
1027 if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
1030 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
1031 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
1033 begin
1034 if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
1036 {$ENDIF}
1037 end
1038 else
1039 begin
1040 {$IFDEF RBHASH_SANITY_CHECKS}
1041 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
1042 {$ENDIF}
1044 // shrink
1047 // mFreeEntryHead will be fixed in `rehash()`
1048 // reinsert entries
1054 var
1056 begin
1060 begin
1062 begin
1070 var
1072 begin
1076 begin
1078 begin
1086 // enumerators
1088 begin
1089 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1094 begin
1095 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1100 begin
1101 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1106 begin
1107 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1112 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1113 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1114 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1117 // ////////////////////////////////////////////////////////////////////////// //
1118 constructor THashBase.TValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1119 begin
1127 begin
1130 begin
1137 begin
1142 // ////////////////////////////////////////////////////////////////////////// //
1143 constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1144 begin
1152 begin
1155 begin
1162 begin
1167 // ////////////////////////////////////////////////////////////////////////// //
1168 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1169 begin
1177 begin
1180 begin
1187 begin