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
57 public
58 type
60 private
63 public
72 private
75 public
84 private
87 public
95 private
101 {$IFDEF RBHASH_SANITY_CHECKS}
103 {$ENDIF}
108 private
112 //function distToStIdx (idx: LongWord): LongWord; inline;
118 public
133 //WARNING! don't modify table in iterator (queries are ok, though)
136 // default `for ... in` enums values
146 type
148 private
152 public
160 // current hash value
161 // you can continue putting data, as this is not destructive
166 type
183 // for integer keys
190 implementation
192 uses
193 SysUtils;
196 // ////////////////////////////////////////////////////////////////////////// //
197 {$PUSH}
198 {$RANGECHECKS OFF}
200 begin
207 // already pot?
208 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
210 {$POP}
213 // ////////////////////////////////////////////////////////////////////////// //
217 {$PUSH}
218 {$RANGECHECKS OFF}
220 begin
232 begin
235 {$POP}
239 begin
245 begin
251 begin
256 // ////////////////////////////////////////////////////////////////////////// //
257 {$PUSH}
258 {$RANGECHECKS OFF}
260 begin
266 begin
272 begin
279 var
282 begin
287 begin
299 begin
305 {$POP}
309 var
311 begin
318 // ////////////////////////////////////////////////////////////////////////// //
319 {$PUSH}
320 {$RANGECHECKS OFF}
321 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
323 var
325 begin
329 begin
336 {$POP}
339 {$PUSH}
340 {$RANGECHECKS OFF}
342 begin
352 {$POP}
355 // ////////////////////////////////////////////////////////////////////////// //
357 begin
358 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
359 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
370 begin
378 var
380 begin
385 {
386 for idx := 0 to High(mEntries)-1 do
387 begin
388 mEntries[idx].hash := 0;
389 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
390 end;
391 mEntries[High(mEntries)].hash := 0;
392 mEntries[High(mEntries)].nextFree := nil;
393 }
394 {
395 for idx := 0 to High(mEntries) do
396 begin
397 mEntries[idx].hash := 0;
398 mEntries[idx].nextFree := nil;
399 end;
400 }
403 {$IFDEF RBHASH_SANITY_CHECKS}
405 {$ENDIF}
413 var
415 begin
417 begin
419 {
420 for idx := 0 to High(mEntries)-1 do
421 begin
422 mEntries[idx].hash := 0;
423 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
424 end;
425 mEntries[High(mEntries)].hash := 0;
426 mEntries[High(mEntries)].nextFree := nil;
427 }
428 {
429 if (mFirstEntry >= 0) then
430 begin
431 for idx := mFirstEntry to mLastEntry do
432 begin
433 mEntries[idx].hash := 0;
434 mEntries[idx].nextFree := nil;
435 end;
436 end;
437 }
440 {$IFDEF RBHASH_SANITY_CHECKS}
442 {$ENDIF}
454 var
456 begin
458 begin
459 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
462 begin
463 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
468 {$IFDEF RBHASH_SANITY_CHECKS}
470 {$ENDIF}
471 exit;
473 {$IFDEF RBHASH_SANITY_CHECKS}
474 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
475 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
476 {$ENDIF}
479 {$IFDEF RBHASH_SANITY_CHECKS}
481 {$ENDIF}
483 // fix mFirstEntry and mLastEntry
485 {$IFDEF RBHASH_SANITY_CHECKS}
486 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
487 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
488 {$ENDIF}
495 var
497 begin
498 {$IFDEF RBHASH_SANITY_CHECKS}
500 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
501 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
502 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
503 {$ENDIF}
505 {$IFDEF RBHASH_SANITY_CHECKS}
506 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
507 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
508 {$ENDIF}
509 {$IFDEF RBHASH_SANITY_CHECKS}
511 {$ENDIF}
515 // fix mFirstEntry and mLastEntry
516 {$IFDEF RBHASH_SANITY_CHECKS}
517 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
518 {$ENDIF}
520 begin
521 {$IFDEF RBHASH_SANITY_CHECKS}
522 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
523 {$ENDIF}
526 end
527 else
528 begin
529 {$IFDEF RBHASH_SANITY_CHECKS}
530 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
531 {$ENDIF}
532 // fix first entry index
534 begin
537 {$IFDEF RBHASH_SANITY_CHECKS}
538 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
539 {$ENDIF}
542 // fix last entry index
544 begin
547 {$IFDEF RBHASH_SANITY_CHECKS}
548 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
549 {$ENDIF}
556 (*
557 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
558 begin
559 {$IFDEF RBHASH_SANITY_CHECKS}
560 assert(idx < Length(mBuckets));
561 assert(mBuckets[idx] <> nil);
562 {$ENDIF}
563 result := mBuckets[idx].hash and High(mBuckets);
564 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
565 end;
566 *)
570 var
574 begin
584 begin
586 //pdist := distToStIdx(idx);
589 //
599 var
603 begin
613 begin
615 //pdist := distToStIdx(idx);
618 //
622 begin
624 break;
634 var
638 begin
641 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
644 begin
646 begin
647 // put entry
651 break;
653 //pdist := distToStIdx(idx);
656 //
658 begin
659 // swapping the current bucket with the one to insert
672 var
677 begin
684 // check if we already have this key
686 begin
688 begin
690 //pdist := distToStIdx(idx);
693 //
697 begin
698 // replace element
699 //mBuckets[idx].key := akey;
701 exit;
707 // need to resize hash?
709 begin
711 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
713 {$IFDEF RBHASH_DEBUG_RESIZE}
714 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
715 {$ENDIF}
717 // resize entries array
721 // mFreeEntryHead will be fixed in `rehash()`
722 // reinsert entries
724 // as seed was changed, recalc hash
728 // create new entry
738 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
740 var
743 begin
751 // find key
754 begin
756 //pdist := distToStIdx(idxcur);
759 //
767 begin
768 // key not found
769 {$IFDEF RBHASH_DEBUG_DELETE}
771 {$ENDIF}
772 exit;
775 {$IFDEF RBHASH_DEBUG_DELETE}
776 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
777 {$ENDIF}
782 begin
783 {$IFDEF RBHASH_DEBUG_DELETE}
784 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
785 {$ENDIF}
786 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
787 //pdist := distToStIdx(idxnext);
790 //
791 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
803 var
807 {$IFDEF RBHASH_SANITY_CHECKS}
809 {$ENDIF}
810 begin
811 // change seed, to minimize pathological cases
814 // clear buckets
817 // reinsert entries
821 begin
824 begin
825 {$IFDEF RBHASH_SANITY_CHECKS}
827 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
829 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
830 {$ENDIF}
833 end
834 else
835 begin
841 {$IFDEF RBHASH_SANITY_CHECKS}
842 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
843 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
844 {$ENDIF}
849 var
851 {$IFDEF RBHASH_SANITY_CHECKS}
853 {$ENDIF}
854 begin
859 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
861 // move all entries to top
863 begin
864 {$IFDEF RBHASH_SANITY_CHECKS}
865 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
866 {$ENDIF}
870 // copy entries
872 begin
874 begin
875 {$IFDEF RBHASH_SANITY_CHECKS}
877 {$ENDIF}
886 {$IFDEF RBHASH_SANITY_CHECKS}
887 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
888 {$ENDIF}
891 {$IFDEF RBHASH_SANITY_CHECKS}
894 begin
895 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
898 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
899 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
901 begin
902 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
904 {$ENDIF}
905 end
906 else
907 begin
908 {$IFDEF RBHASH_SANITY_CHECKS}
909 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
910 {$ENDIF}
912 // shrink
915 // mFreeEntryHead will be fixed in `rehash()`
916 // reinsert entries
922 var
924 begin
930 begin
932 begin
941 // enumerators
943 begin
944 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
949 begin
950 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
955 begin
956 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
961 begin
962 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
967 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
968 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
969 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
972 // ////////////////////////////////////////////////////////////////////////// //
974 begin
982 begin
985 begin
992 begin
997 // ////////////////////////////////////////////////////////////////////////// //
999 begin
1007 begin
1010 begin
1017 begin
1022 // ////////////////////////////////////////////////////////////////////////// //
1023 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1024 begin
1032 begin
1035 begin
1042 begin