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
37 public
40 type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
42 type
45 public
48 private
53 private
54 type
58 private
61 public
69 private
72 public
80 private
83 public
90 private
96 {$IFDEF RBHASH_SANITY_CHECKS}
98 {$ENDIF}
103 private
107 //function distToStIdx (idx: LongWord): LongWord; inline;
113 public
128 //WARNING! don't modify table in iterator (queries are ok, though)
131 // default `for ... in` enums values
141 type
143 private
147 public
155 // current hash value
156 // you can continue putting data, as this is not destructive
161 type
178 // for integer keys
185 implementation
187 uses
188 SysUtils;
191 // ////////////////////////////////////////////////////////////////////////// //
192 {$PUSH}
193 {$RANGECHECKS OFF}
195 begin
202 // already pot?
203 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
205 {$POP}
208 // ////////////////////////////////////////////////////////////////////////// //
212 {$PUSH}
213 {$RANGECHECKS OFF}
215 begin
227 begin
230 {$POP}
234 begin
240 begin
246 begin
251 // ////////////////////////////////////////////////////////////////////////// //
252 {$PUSH}
253 {$RANGECHECKS OFF}
255 begin
261 begin
267 begin
274 var
277 begin
282 begin
294 begin
300 {$POP}
304 var
306 begin
313 // ////////////////////////////////////////////////////////////////////////// //
314 {$PUSH}
315 {$RANGECHECKS OFF}
316 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
318 var
320 begin
324 begin
331 {$POP}
334 {$PUSH}
335 {$RANGECHECKS OFF}
337 begin
347 {$POP}
350 // ////////////////////////////////////////////////////////////////////////// //
352 begin
353 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
354 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
365 begin
373 var
375 begin
380 {
381 for idx := 0 to High(mEntries)-1 do
382 begin
383 mEntries[idx].hash := 0;
384 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
385 end;
386 mEntries[High(mEntries)].hash := 0;
387 mEntries[High(mEntries)].nextFree := nil;
388 }
389 {
390 for idx := 0 to High(mEntries) do
391 begin
392 mEntries[idx].hash := 0;
393 mEntries[idx].nextFree := nil;
394 end;
395 }
398 {$IFDEF RBHASH_SANITY_CHECKS}
400 {$ENDIF}
408 var
410 begin
412 begin
414 {
415 for idx := 0 to High(mEntries)-1 do
416 begin
417 mEntries[idx].hash := 0;
418 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
419 end;
420 mEntries[High(mEntries)].hash := 0;
421 mEntries[High(mEntries)].nextFree := nil;
422 }
423 {
424 if (mFirstEntry >= 0) then
425 begin
426 for idx := mFirstEntry to mLastEntry do
427 begin
428 mEntries[idx].hash := 0;
429 mEntries[idx].nextFree := nil;
430 end;
431 end;
432 }
435 {$IFDEF RBHASH_SANITY_CHECKS}
437 {$ENDIF}
449 var
451 begin
453 begin
454 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
457 begin
458 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
463 {$IFDEF RBHASH_SANITY_CHECKS}
465 {$ENDIF}
466 exit;
468 {$IFDEF RBHASH_SANITY_CHECKS}
469 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
470 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
471 {$ENDIF}
474 {$IFDEF RBHASH_SANITY_CHECKS}
476 {$ENDIF}
478 // fix mFirstEntry and mLastEntry
480 {$IFDEF RBHASH_SANITY_CHECKS}
481 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
482 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
483 {$ENDIF}
490 var
492 begin
493 {$IFDEF RBHASH_SANITY_CHECKS}
495 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
496 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
497 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
498 {$ENDIF}
500 {$IFDEF RBHASH_SANITY_CHECKS}
501 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
502 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
503 {$ENDIF}
504 {$IFDEF RBHASH_SANITY_CHECKS}
506 {$ENDIF}
510 // fix mFirstEntry and mLastEntry
511 {$IFDEF RBHASH_SANITY_CHECKS}
512 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
513 {$ENDIF}
515 begin
516 {$IFDEF RBHASH_SANITY_CHECKS}
517 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
518 {$ENDIF}
521 end
522 else
523 begin
524 {$IFDEF RBHASH_SANITY_CHECKS}
525 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
526 {$ENDIF}
527 // fix first entry index
529 begin
532 {$IFDEF RBHASH_SANITY_CHECKS}
533 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
534 {$ENDIF}
537 // fix last entry index
539 begin
542 {$IFDEF RBHASH_SANITY_CHECKS}
543 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
544 {$ENDIF}
551 (*
552 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
553 begin
554 {$IFDEF RBHASH_SANITY_CHECKS}
555 assert(idx < Length(mBuckets));
556 assert(mBuckets[idx] <> nil);
557 {$ENDIF}
558 result := mBuckets[idx].hash and High(mBuckets);
559 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
560 end;
561 *)
565 var
569 begin
579 begin
581 //pdist := distToStIdx(idx);
584 //
594 var
598 begin
608 begin
610 //pdist := distToStIdx(idx);
613 //
617 begin
619 break;
629 var
633 begin
636 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
639 begin
641 begin
642 // put entry
646 break;
648 //pdist := distToStIdx(idx);
651 //
653 begin
654 // swapping the current bucket with the one to insert
667 var
672 begin
679 // check if we already have this key
681 begin
683 begin
685 //pdist := distToStIdx(idx);
688 //
692 begin
693 // replace element
694 //mBuckets[idx].key := akey;
696 exit;
702 // need to resize hash?
704 begin
706 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
708 {$IFDEF RBHASH_DEBUG_RESIZE}
709 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
710 {$ENDIF}
712 // resize entries array
716 // mFreeEntryHead will be fixed in `rehash()`
717 // reinsert entries
719 // as seed was changed, recalc hash
723 // create new entry
733 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
735 var
738 begin
746 // find key
749 begin
751 //pdist := distToStIdx(idxcur);
754 //
762 begin
763 // key not found
764 {$IFDEF RBHASH_DEBUG_DELETE}
766 {$ENDIF}
767 exit;
770 {$IFDEF RBHASH_DEBUG_DELETE}
771 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
772 {$ENDIF}
777 begin
778 {$IFDEF RBHASH_DEBUG_DELETE}
779 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
780 {$ENDIF}
781 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
782 //pdist := distToStIdx(idxnext);
785 //
786 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
798 var
802 {$IFDEF RBHASH_SANITY_CHECKS}
804 {$ENDIF}
805 begin
806 // change seed, to minimize pathological cases
809 // clear buckets
812 // reinsert entries
816 begin
819 begin
820 {$IFDEF RBHASH_SANITY_CHECKS}
822 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
824 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
825 {$ENDIF}
828 end
829 else
830 begin
836 {$IFDEF RBHASH_SANITY_CHECKS}
837 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
838 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
839 {$ENDIF}
844 var
846 {$IFDEF RBHASH_SANITY_CHECKS}
848 {$ENDIF}
849 begin
854 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
856 // move all entries to top
858 begin
859 {$IFDEF RBHASH_SANITY_CHECKS}
860 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
861 {$ENDIF}
865 // copy entries
867 begin
869 begin
870 {$IFDEF RBHASH_SANITY_CHECKS}
872 {$ENDIF}
881 {$IFDEF RBHASH_SANITY_CHECKS}
882 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
883 {$ENDIF}
886 {$IFDEF RBHASH_SANITY_CHECKS}
889 begin
890 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
893 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
894 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
896 begin
897 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
899 {$ENDIF}
900 end
901 else
902 begin
903 {$IFDEF RBHASH_SANITY_CHECKS}
904 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
905 {$ENDIF}
907 // shrink
910 // mFreeEntryHead will be fixed in `rehash()`
911 // reinsert entries
917 var
919 begin
925 begin
927 begin
936 // enumerators
938 begin
939 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
944 begin
945 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
950 begin
951 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
956 begin
957 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
962 // ////////////////////////////////////////////////////////////////////////// //
964 begin
972 begin
975 begin
982 begin
987 // ////////////////////////////////////////////////////////////////////////// //
989 begin
997 begin
1000 begin
1007 begin
1012 // ////////////////////////////////////////////////////////////////////////// //
1013 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1014 begin
1022 begin
1025 begin
1032 begin