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
30 type
31 // WARNING! don't put structures into hash, use ponters or ids!
33 private
34 const InitSize = {$IF DEFINED(RBHASH_SANITY_CHECKS)}16{$ELSE}256{$ENDIF}; // *MUST* be power of two
37 public
38 type
41 public
44 private
47 private
49 public
58 type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
59 type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
61 private
62 type
65 public
66 type
68 private
71 public
80 private
83 public
92 private
95 public
103 private
111 {$IFDEF RBHASH_SANITY_CHECKS}
113 {$ENDIF}
118 private
130 public
131 constructor Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
140 // you may pass `keyhash` to bypass hash calculation
141 function get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean; // `true`: found
142 // the function may return calculated value hash in `keyhash`
143 function put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean; // `true`: replaced
144 // you may pass `keyhash` to bypass hash calculation
146 // you may pass `keyhash` to bypass hash calculation
149 //WARNING! don't modify table in iterator (queries are ok, though)
153 // default `for ... in` enums values
163 type
165 private
169 public
177 // current hash value
178 // you can continue putting data, as this is not destructive
183 type
203 // for integer keys
211 implementation
213 uses
214 SysUtils;
217 // ////////////////////////////////////////////////////////////////////////// //
218 {$PUSH}
219 {$RANGECHECKS OFF}
221 begin
228 // already pot?
229 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
231 {$POP}
234 // ////////////////////////////////////////////////////////////////////////// //
239 {$PUSH}
240 {$RANGECHECKS OFF}
242 begin
254 begin
257 {$POP}
261 begin
267 begin
273 begin
279 begin
284 // ////////////////////////////////////////////////////////////////////////// //
285 {$PUSH}
286 {$RANGECHECKS OFF}
288 begin
294 begin
300 begin
307 var
310 begin
315 begin
327 begin
333 {$POP}
337 var
339 begin
346 // ////////////////////////////////////////////////////////////////////////// //
347 {$PUSH}
348 {$RANGECHECKS OFF}
349 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
351 var
353 begin
357 begin
364 {$POP}
367 {$PUSH}
368 {$RANGECHECKS OFF}
370 begin
380 {$POP}
383 // ////////////////////////////////////////////////////////////////////////// //
387 // ////////////////////////////////////////////////////////////////////////// //
391 constructor THashBase.Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
392 begin
393 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
394 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
409 begin
417 var
420 begin
422 begin
424 begin
427 begin
435 end
437 begin
443 {$IFDEF RBHASH_SANITY_CHECKS}
445 {$ENDIF}
450 //var idx: Integer;
451 begin
455 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
463 //var idx: Integer;
464 begin
467 begin
468 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
476 var
478 begin
480 begin
481 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
484 begin
485 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
490 {$IFDEF RBHASH_SANITY_CHECKS}
492 {$ENDIF}
493 exit;
495 {$IFDEF RBHASH_SANITY_CHECKS}
496 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
497 if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
498 {$ENDIF}
501 {$IFDEF RBHASH_SANITY_CHECKS}
503 {$ENDIF}
505 // fix mFirstEntry and mLastEntry
507 {$IFDEF RBHASH_SANITY_CHECKS}
508 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
509 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
510 {$ENDIF}
517 var
519 begin
520 {$IFDEF RBHASH_SANITY_CHECKS}
522 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
523 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
524 if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
525 {$ENDIF}
527 {$IFDEF RBHASH_SANITY_CHECKS}
528 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
529 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
530 {$ENDIF}
533 {$IFDEF RBHASH_SANITY_CHECKS}
535 {$ENDIF}
541 // fix mFirstEntry and mLastEntry
542 {$IFDEF RBHASH_SANITY_CHECKS}
543 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
544 {$ENDIF}
546 begin
547 {$IFDEF RBHASH_SANITY_CHECKS}
548 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
549 {$ENDIF}
553 end
554 else
555 begin
556 {$IFDEF RBHASH_SANITY_CHECKS}
557 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
558 {$ENDIF}
559 // fix first entry index
561 begin
564 {$IFDEF RBHASH_SANITY_CHECKS}
565 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
566 {$ENDIF}
569 // fix last entry index
571 begin
574 {$IFDEF RBHASH_SANITY_CHECKS}
575 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
576 {$ENDIF}
584 begin
585 {$IFDEF RBHASH_SANITY_CHECKS}
588 {$ENDIF}
595 var
599 begin
607 begin
610 end
611 else
612 begin
621 begin
632 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
633 var
637 begin
645 begin
648 end
649 else
650 begin
658 begin
672 var
676 begin
680 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
683 begin
685 begin
686 // put entry
690 break;
694 begin
695 // swapping the current bucket with the one to insert
707 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
708 var
713 begin
723 // check if we already have this key
725 begin
727 begin
733 begin
734 // replace element
739 exit;
745 // need to resize hash?
747 begin
749 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
751 {$IFDEF RBHASH_DEBUG_RESIZE}
752 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
753 {$ENDIF}
755 // resize entries array
759 // mFreeEntryHead will be fixed in `rehash()`
760 // reinsert entries
764 // create new entry
774 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
776 var
779 begin
787 begin
790 end
791 else
792 begin
799 // find key
802 begin
812 begin
813 // key not found
814 {$IFDEF RBHASH_DEBUG_DELETE}
816 {$ENDIF}
817 exit;
820 {$IFDEF RBHASH_DEBUG_DELETE}
821 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
822 {$ENDIF}
827 begin
828 {$IFDEF RBHASH_DEBUG_DELETE}
829 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
830 {$ENDIF}
831 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
833 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
845 var
849 {$IFDEF RBHASH_SANITY_CHECKS}
851 {$ENDIF}
852 begin
853 // change seed, to minimize pathological cases
854 //TODO: use prng to generate new hash
857 // clear buckets
858 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
861 // reinsert entries
865 begin
868 begin
869 {$IFDEF RBHASH_SANITY_CHECKS}
871 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
873 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
874 {$ENDIF}
875 // no need to recalculate hash
876 //e.hash := hashfn(e.key) xor mSeed; if (e.hash = 0) then e.hash := $29a;
878 end
879 else
880 begin
886 {$IFDEF RBHASH_SANITY_CHECKS}
887 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
888 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
889 {$ENDIF}
894 var
896 {$IFDEF RBHASH_SANITY_CHECKS}
898 {$ENDIF}
899 begin
904 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
906 // move all entries to top
908 begin
909 {$IFDEF RBHASH_SANITY_CHECKS}
910 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
911 {$ENDIF}
915 // copy entries
917 begin
919 begin
920 {$IFDEF RBHASH_SANITY_CHECKS}
922 {$ENDIF}
931 {$IFDEF RBHASH_SANITY_CHECKS}
932 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
933 {$ENDIF}
936 {$IFDEF RBHASH_SANITY_CHECKS}
939 begin
940 if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
943 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
944 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
946 begin
947 if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
949 {$ENDIF}
950 end
951 else
952 begin
953 {$IFDEF RBHASH_SANITY_CHECKS}
954 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
955 {$ENDIF}
957 // shrink
960 // mFreeEntryHead will be fixed in `rehash()`
961 // reinsert entries
967 var
969 begin
973 begin
975 begin
983 var
985 begin
989 begin
991 begin
999 // enumerators
1001 begin
1002 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1007 begin
1008 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1013 begin
1014 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1019 begin
1020 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1025 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1026 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1027 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1030 // ////////////////////////////////////////////////////////////////////////// //
1031 constructor THashBase.TValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1032 begin
1040 begin
1043 begin
1050 begin
1055 // ////////////////////////////////////////////////////////////////////////// //
1056 constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1057 begin
1065 begin
1068 begin
1075 begin
1080 // ////////////////////////////////////////////////////////////////////////// //
1081 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1082 begin
1090 begin
1093 begin
1100 begin