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
176 // for integer keys
181 implementation
183 uses
184 SysUtils;
187 // ////////////////////////////////////////////////////////////////////////// //
188 {$PUSH}
189 {$RANGECHECKS OFF}
191 begin
198 // already pot?
199 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
201 {$POP}
204 // ////////////////////////////////////////////////////////////////////////// //
208 {$PUSH}
209 {$RANGECHECKS OFF}
211 begin
223 begin
226 {$POP}
230 begin
236 begin
241 // ////////////////////////////////////////////////////////////////////////// //
242 {$PUSH}
243 {$RANGECHECKS OFF}
245 begin
251 begin
257 begin
264 var
267 begin
272 begin
284 begin
290 {$POP}
294 var
296 begin
303 // ////////////////////////////////////////////////////////////////////////// //
304 {$PUSH}
305 {$RANGECHECKS OFF}
306 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
308 var
310 begin
314 begin
321 {$POP}
324 {$PUSH}
325 {$RANGECHECKS OFF}
327 begin
337 {$POP}
340 // ////////////////////////////////////////////////////////////////////////// //
342 begin
343 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
344 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
355 begin
363 var
365 begin
370 {
371 for idx := 0 to High(mEntries)-1 do
372 begin
373 mEntries[idx].hash := 0;
374 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
375 end;
376 mEntries[High(mEntries)].hash := 0;
377 mEntries[High(mEntries)].nextFree := nil;
378 }
379 {
380 for idx := 0 to High(mEntries) do
381 begin
382 mEntries[idx].hash := 0;
383 mEntries[idx].nextFree := nil;
384 end;
385 }
388 {$IFDEF RBHASH_SANITY_CHECKS}
390 {$ENDIF}
398 var
400 begin
402 begin
404 {
405 for idx := 0 to High(mEntries)-1 do
406 begin
407 mEntries[idx].hash := 0;
408 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
409 end;
410 mEntries[High(mEntries)].hash := 0;
411 mEntries[High(mEntries)].nextFree := nil;
412 }
413 {
414 if (mFirstEntry >= 0) then
415 begin
416 for idx := mFirstEntry to mLastEntry do
417 begin
418 mEntries[idx].hash := 0;
419 mEntries[idx].nextFree := nil;
420 end;
421 end;
422 }
425 {$IFDEF RBHASH_SANITY_CHECKS}
427 {$ENDIF}
439 var
441 begin
443 begin
444 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
447 begin
448 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
453 {$IFDEF RBHASH_SANITY_CHECKS}
455 {$ENDIF}
456 exit;
458 {$IFDEF RBHASH_SANITY_CHECKS}
459 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
460 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
461 {$ENDIF}
464 {$IFDEF RBHASH_SANITY_CHECKS}
466 {$ENDIF}
468 // fix mFirstEntry and mLastEntry
470 {$IFDEF RBHASH_SANITY_CHECKS}
471 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
472 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
473 {$ENDIF}
480 var
482 begin
483 {$IFDEF RBHASH_SANITY_CHECKS}
485 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
486 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
487 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
488 {$ENDIF}
490 {$IFDEF RBHASH_SANITY_CHECKS}
491 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
492 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
493 {$ENDIF}
494 {$IFDEF RBHASH_SANITY_CHECKS}
496 {$ENDIF}
500 // fix mFirstEntry and mLastEntry
501 {$IFDEF RBHASH_SANITY_CHECKS}
502 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
503 {$ENDIF}
505 begin
506 {$IFDEF RBHASH_SANITY_CHECKS}
507 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
508 {$ENDIF}
511 end
512 else
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; 2)');
516 {$ENDIF}
517 // fix first entry index
519 begin
522 {$IFDEF RBHASH_SANITY_CHECKS}
523 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
524 {$ENDIF}
527 // fix last entry index
529 begin
532 {$IFDEF RBHASH_SANITY_CHECKS}
533 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
534 {$ENDIF}
541 (*
542 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
543 begin
544 {$IFDEF RBHASH_SANITY_CHECKS}
545 assert(idx < Length(mBuckets));
546 assert(mBuckets[idx] <> nil);
547 {$ENDIF}
548 result := mBuckets[idx].hash and High(mBuckets);
549 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
550 end;
551 *)
555 var
559 begin
569 begin
571 //pdist := distToStIdx(idx);
574 //
584 var
588 begin
598 begin
600 //pdist := distToStIdx(idx);
603 //
607 begin
609 break;
619 var
623 begin
626 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
629 begin
631 begin
632 // put entry
636 break;
638 //pdist := distToStIdx(idx);
641 //
643 begin
644 // swapping the current bucket with the one to insert
657 var
662 begin
669 // check if we already have this key
671 begin
673 begin
675 //pdist := distToStIdx(idx);
678 //
682 begin
683 // replace element
684 //mBuckets[idx].key := akey;
686 exit;
692 // need to resize hash?
694 begin
696 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
698 {$IFDEF RBHASH_DEBUG_RESIZE}
699 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
700 {$ENDIF}
702 // resize entries array
706 // mFreeEntryHead will be fixed in `rehash()`
707 // reinsert entries
709 // as seed was changed, recalc hash
713 // create new entry
723 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
725 var
728 begin
736 // find key
739 begin
741 //pdist := distToStIdx(idxcur);
744 //
752 begin
753 // key not found
754 {$IFDEF RBHASH_DEBUG_DELETE}
756 {$ENDIF}
757 exit;
760 {$IFDEF RBHASH_DEBUG_DELETE}
761 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
762 {$ENDIF}
767 begin
768 {$IFDEF RBHASH_DEBUG_DELETE}
769 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
770 {$ENDIF}
771 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
772 //pdist := distToStIdx(idxnext);
775 //
776 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
788 var
792 {$IFDEF RBHASH_SANITY_CHECKS}
794 {$ENDIF}
795 begin
796 // change seed, to minimize pathological cases
799 // clear buckets
802 // reinsert entries
806 begin
809 begin
810 {$IFDEF RBHASH_SANITY_CHECKS}
812 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
814 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
815 {$ENDIF}
818 end
819 else
820 begin
826 {$IFDEF RBHASH_SANITY_CHECKS}
827 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
828 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
829 {$ENDIF}
834 var
836 {$IFDEF RBHASH_SANITY_CHECKS}
838 {$ENDIF}
839 begin
844 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
846 // move all entries to top
848 begin
849 {$IFDEF RBHASH_SANITY_CHECKS}
850 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
851 {$ENDIF}
855 // copy entries
857 begin
859 begin
860 {$IFDEF RBHASH_SANITY_CHECKS}
862 {$ENDIF}
871 {$IFDEF RBHASH_SANITY_CHECKS}
872 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
873 {$ENDIF}
876 {$IFDEF RBHASH_SANITY_CHECKS}
879 begin
880 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
883 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
884 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
886 begin
887 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
889 {$ENDIF}
890 end
891 else
892 begin
893 {$IFDEF RBHASH_SANITY_CHECKS}
894 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
895 {$ENDIF}
897 // shrink
900 // mFreeEntryHead will be fixed in `rehash()`
901 // reinsert entries
907 var
909 begin
915 begin
917 begin
926 // enumerators
928 begin
929 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
934 begin
935 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
940 begin
941 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
946 begin
947 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
952 // ////////////////////////////////////////////////////////////////////////// //
954 begin
962 begin
965 begin
972 begin
977 // ////////////////////////////////////////////////////////////////////////// //
979 begin
987 begin
990 begin
997 begin
1002 // ////////////////////////////////////////////////////////////////////////// //
1003 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1004 begin
1012 begin
1015 begin
1022 begin