33920a176e70261225a843d9ffc0dd0cb7663937
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 type
209 // has to be public due to FPC generics limitation
213 implementation
215 uses
219 // ////////////////////////////////////////////////////////////////////////// //
220 {$PUSH}
221 {$RANGECHECKS OFF}
223 begin
230 // already pot?
231 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
233 {$POP}
236 // ////////////////////////////////////////////////////////////////////////// //
237 {$PUSH}
238 {$RANGECHECKS OFF}
240 begin
245 begin
250 begin
256 var
259 begin
264 begin
275 begin
281 {$POP}
285 var
287 begin
294 // ////////////////////////////////////////////////////////////////////////// //
295 {$PUSH}
296 {$RANGECHECKS OFF}
297 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
299 var
301 begin
305 begin
312 {$POP}
315 {$PUSH}
316 {$RANGECHECKS OFF}
318 begin
328 {$POP}
331 // ////////////////////////////////////////////////////////////////////////// //
332 // THashKeyInt
334 begin
345 class function THashKeyInt.equ (const a, b: Integer): Boolean; inline; begin result := (a = b); end;
349 // ////////////////////////////////////////////////////////////////////////// //
350 // THashKeyStr
351 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;
352 class function THashKeyStr.equ (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
356 // ////////////////////////////////////////////////////////////////////////// //
360 // ////////////////////////////////////////////////////////////////////////// //
365 begin
376 begin
384 var
387 begin
389 begin
391 begin
394 begin
402 end
404 begin
410 {$IFDEF RBHASH_SANITY_CHECKS}
412 {$ENDIF}
417 //var idx: Integer;
418 begin
422 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
430 //var idx: Integer;
431 begin
434 begin
435 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
443 var
445 begin
447 begin
448 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
451 begin
452 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
457 {$IFDEF RBHASH_SANITY_CHECKS}
459 {$ENDIF}
460 exit;
462 {$IFDEF RBHASH_SANITY_CHECKS}
463 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
464 if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
465 {$ENDIF}
468 {$IFDEF RBHASH_SANITY_CHECKS}
470 {$ENDIF}
472 // fix mFirstEntry and mLastEntry
474 {$IFDEF RBHASH_SANITY_CHECKS}
475 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
476 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
477 {$ENDIF}
484 var
486 begin
487 {$IFDEF RBHASH_SANITY_CHECKS}
489 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
490 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
491 if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
492 {$ENDIF}
494 {$IFDEF RBHASH_SANITY_CHECKS}
495 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
496 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
497 {$ENDIF}
500 {$IFDEF RBHASH_SANITY_CHECKS}
502 {$ENDIF}
508 // fix mFirstEntry and mLastEntry
509 {$IFDEF RBHASH_SANITY_CHECKS}
510 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
511 {$ENDIF}
513 begin
514 {$IFDEF RBHASH_SANITY_CHECKS}
515 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
516 {$ENDIF}
520 end
521 else
522 begin
523 {$IFDEF RBHASH_SANITY_CHECKS}
524 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
525 {$ENDIF}
526 // fix first entry index
528 begin
531 {$IFDEF RBHASH_SANITY_CHECKS}
532 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
533 {$ENDIF}
536 // fix last entry index
538 begin
541 {$IFDEF RBHASH_SANITY_CHECKS}
542 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
543 {$ENDIF}
551 begin
552 {$IFDEF RBHASH_SANITY_CHECKS}
555 {$ENDIF}
562 var
566 begin
574 begin
577 end
578 else
579 begin
588 begin
599 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
600 var
604 begin
612 begin
615 end
616 else
617 begin
625 begin
639 var
643 begin
647 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
650 begin
652 begin
653 // put entry
657 break;
661 begin
662 // swapping the current bucket with the one to insert
674 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
675 var
680 begin
690 // check if we already have this key
692 begin
694 begin
700 begin
701 // replace element
703 if assigned(freevalfn) then freevalfn(mBuckets[idx].value) else mBuckets[idx].value := Default(ValueT);
706 exit;
712 // need to resize hash?
714 begin
716 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
718 {$IFDEF RBHASH_DEBUG_RESIZE}
719 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
720 {$ENDIF}
722 // resize entries array
726 // mFreeEntryHead will be fixed in `rehash()`
727 // reinsert entries
731 // create new entry
741 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
743 var
746 begin
754 begin
757 end
758 else
759 begin
766 // find key
769 begin
779 begin
780 // key not found
781 {$IFDEF RBHASH_DEBUG_DELETE}
783 {$ENDIF}
784 exit;
787 {$IFDEF RBHASH_DEBUG_DELETE}
788 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
789 {$ENDIF}
794 begin
795 {$IFDEF RBHASH_DEBUG_DELETE}
796 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
797 {$ENDIF}
798 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
800 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
812 var
816 {$IFDEF RBHASH_SANITY_CHECKS}
818 {$ENDIF}
819 begin
820 // change seed, to minimize pathological cases
821 //TODO: use prng to generate new hash
824 // clear buckets
825 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
828 // reinsert entries
832 begin
835 begin
836 {$IFDEF RBHASH_SANITY_CHECKS}
838 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
840 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
841 {$ENDIF}
842 // no need to recalculate hash
844 end
845 else
846 begin
852 {$IFDEF RBHASH_SANITY_CHECKS}
853 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
854 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
855 {$ENDIF}
860 var
862 {$IFDEF RBHASH_SANITY_CHECKS}
864 {$ENDIF}
865 begin
870 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
872 // move all entries to top
874 begin
875 {$IFDEF RBHASH_SANITY_CHECKS}
876 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
877 {$ENDIF}
881 // copy entries
883 begin
885 begin
886 {$IFDEF RBHASH_SANITY_CHECKS}
888 {$ENDIF}
897 {$IFDEF RBHASH_SANITY_CHECKS}
898 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
899 {$ENDIF}
902 {$IFDEF RBHASH_SANITY_CHECKS}
905 begin
906 if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
909 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
910 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
912 begin
913 if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
915 {$ENDIF}
916 end
917 else
918 begin
919 {$IFDEF RBHASH_SANITY_CHECKS}
920 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
921 {$ENDIF}
923 // shrink
926 // mFreeEntryHead will be fixed in `rehash()`
927 // reinsert entries
933 var
935 begin
939 begin
941 begin
949 var
951 begin
955 begin
957 begin
965 // enumerators
967 begin
968 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
973 begin
974 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
979 begin
980 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
985 begin
986 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
991 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
992 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
993 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
996 // ////////////////////////////////////////////////////////////////////////// //
998 begin
1006 begin
1009 begin
1016 begin
1021 // ////////////////////////////////////////////////////////////////////////// //
1022 constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1023 begin
1031 begin
1034 begin
1041 begin
1046 // ////////////////////////////////////////////////////////////////////////// //
1047 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1048 begin
1056 begin
1059 begin
1066 begin