a51fc91d27519874d875a6b2799ab85b7230c599
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
40 type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
41 type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
43 type
46 public
49 private
52 public
56 private
57 type
60 public
61 type
63 private
66 public
75 private
78 public
87 private
90 public
98 private
104 {$IFDEF RBHASH_SANITY_CHECKS}
106 {$ENDIF}
111 private
115 //function distToStIdx (idx: LongWord): LongWord; inline;
121 public
131 // you may pass `keyhash` to bypass hash calculation
132 function get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean; // `true`: found
133 // the function may return calculated value hash in `keyhash`
134 function put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean; // `true`: replaced
135 // you may pass `keyhash` to bypass hash calculation
137 // you may pass `keyhash` to bypass hash calculation
140 //WARNING! don't modify table in iterator (queries are ok, though)
144 // default `for ... in` enums values
154 type
156 private
160 public
168 // current hash value
169 // you can continue putting data, as this is not destructive
174 type
191 // for integer keys
198 implementation
200 uses
201 SysUtils;
204 // ////////////////////////////////////////////////////////////////////////// //
205 {$PUSH}
206 {$RANGECHECKS OFF}
208 begin
215 // already pot?
216 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
218 {$POP}
221 // ////////////////////////////////////////////////////////////////////////// //
225 {$PUSH}
226 {$RANGECHECKS OFF}
228 begin
240 begin
243 {$POP}
247 begin
253 begin
259 begin
264 // ////////////////////////////////////////////////////////////////////////// //
265 {$PUSH}
266 {$RANGECHECKS OFF}
268 begin
274 begin
280 begin
287 var
290 begin
295 begin
307 begin
313 {$POP}
317 var
319 begin
326 // ////////////////////////////////////////////////////////////////////////// //
327 {$PUSH}
328 {$RANGECHECKS OFF}
329 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
331 var
333 begin
337 begin
344 {$POP}
347 {$PUSH}
348 {$RANGECHECKS OFF}
350 begin
360 {$POP}
363 // ////////////////////////////////////////////////////////////////////////// //
365 begin
366 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
367 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
378 begin
386 var
388 begin
393 {$IFDEF RBHASH_SANITY_CHECKS}
395 {$ENDIF}
403 var
405 begin
407 begin
410 {$IFDEF RBHASH_SANITY_CHECKS}
412 {$ENDIF}
424 var
426 begin
428 begin
429 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
432 begin
433 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
438 {$IFDEF RBHASH_SANITY_CHECKS}
440 {$ENDIF}
441 exit;
443 {$IFDEF RBHASH_SANITY_CHECKS}
444 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
445 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
446 {$ENDIF}
449 {$IFDEF RBHASH_SANITY_CHECKS}
451 {$ENDIF}
453 // fix mFirstEntry and mLastEntry
455 {$IFDEF RBHASH_SANITY_CHECKS}
456 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
457 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
458 {$ENDIF}
465 var
467 begin
468 {$IFDEF RBHASH_SANITY_CHECKS}
470 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
471 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
472 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
473 {$ENDIF}
475 {$IFDEF RBHASH_SANITY_CHECKS}
476 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
477 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
478 {$ENDIF}
479 {$IFDEF RBHASH_SANITY_CHECKS}
481 {$ENDIF}
485 // fix mFirstEntry and mLastEntry
486 {$IFDEF RBHASH_SANITY_CHECKS}
487 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
488 {$ENDIF}
490 begin
491 {$IFDEF RBHASH_SANITY_CHECKS}
492 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
493 {$ENDIF}
496 end
497 else
498 begin
499 {$IFDEF RBHASH_SANITY_CHECKS}
500 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
501 {$ENDIF}
502 // fix first entry index
504 begin
507 {$IFDEF RBHASH_SANITY_CHECKS}
508 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
509 {$ENDIF}
512 // fix last entry index
514 begin
517 {$IFDEF RBHASH_SANITY_CHECKS}
518 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
519 {$ENDIF}
526 (*
527 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
528 begin
529 {$IFDEF RBHASH_SANITY_CHECKS}
530 assert(idx < Length(mBuckets));
531 assert(mBuckets[idx] <> nil);
532 {$ENDIF}
533 result := (mBuckets[idx].hash xor mSeed) and High(mBuckets);
534 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
535 end;
536 *)
540 var
544 begin
552 begin
555 end
556 else
557 begin
566 begin
568 //pdist := distToStIdx(idx);
571 //
580 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
581 var
585 begin
593 begin
596 end
597 else
598 begin
606 begin
608 //pdist := distToStIdx(idx);
611 //
623 var
627 begin
631 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
634 begin
636 begin
637 // put entry
641 break;
643 //pdist := distToStIdx(idx);
646 //
648 begin
649 // swapping the current bucket with the one to insert
661 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
662 var
667 begin
677 // check if we already have this key
679 begin
681 begin
683 //pdist := distToStIdx(idx);
686 //
690 begin
691 // replace element
692 //mBuckets[idx].key := akey;
694 exit;
700 // need to resize hash?
702 begin
704 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
706 {$IFDEF RBHASH_DEBUG_RESIZE}
707 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
708 {$ENDIF}
710 // resize entries array
714 // mFreeEntryHead will be fixed in `rehash()`
715 // reinsert entries
719 // create new entry
729 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
731 var
734 begin
742 begin
745 end
746 else
747 begin
754 // find key
757 begin
759 //pdist := distToStIdx(idxcur);
762 //
770 begin
771 // key not found
772 {$IFDEF RBHASH_DEBUG_DELETE}
774 {$ENDIF}
775 exit;
778 {$IFDEF RBHASH_DEBUG_DELETE}
779 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
780 {$ENDIF}
785 begin
786 {$IFDEF RBHASH_DEBUG_DELETE}
787 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
788 {$ENDIF}
789 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
790 //pdist := distToStIdx(idxnext);
793 //
794 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
806 var
810 {$IFDEF RBHASH_SANITY_CHECKS}
812 {$ENDIF}
813 begin
814 // change seed, to minimize pathological cases
815 //TODO: use prng to generate new hash
818 // clear buckets
821 // reinsert entries
825 begin
828 begin
829 {$IFDEF RBHASH_SANITY_CHECKS}
831 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
833 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
834 {$ENDIF}
835 // no need to recalculate hash
836 //e.hash := hashfn(e.key) xor mSeed; if (e.hash = 0) then e.hash := $29a;
838 end
839 else
840 begin
846 {$IFDEF RBHASH_SANITY_CHECKS}
847 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
848 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
849 {$ENDIF}
854 var
856 {$IFDEF RBHASH_SANITY_CHECKS}
858 {$ENDIF}
859 begin
864 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
866 // move all entries to top
868 begin
869 {$IFDEF RBHASH_SANITY_CHECKS}
870 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
871 {$ENDIF}
875 // copy entries
877 begin
879 begin
880 {$IFDEF RBHASH_SANITY_CHECKS}
882 {$ENDIF}
891 {$IFDEF RBHASH_SANITY_CHECKS}
892 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
893 {$ENDIF}
896 {$IFDEF RBHASH_SANITY_CHECKS}
899 begin
900 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
903 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
904 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
906 begin
907 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
909 {$ENDIF}
910 end
911 else
912 begin
913 {$IFDEF RBHASH_SANITY_CHECKS}
914 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
915 {$ENDIF}
917 // shrink
920 // mFreeEntryHead will be fixed in `rehash()`
921 // reinsert entries
927 var
929 begin
935 begin
937 begin
946 var
948 begin
954 begin
956 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