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
56 private
59 public
67 private
70 public
78 private
81 public
88 private
94 {$IFDEF RBHASH_SANITY_CHECKS}
96 {$ENDIF}
101 private
105 //function distToStIdx (idx: LongWord): LongWord; inline;
111 public
126 //WARNING! don't modify table in iterator (queries are ok, though)
129 // default `for ... in` enums values
139 type
141 private
145 public
153 // current hash value
154 // you can continue putting data, as this is not destructive
159 type
174 implementation
176 uses
177 SysUtils;
180 // ////////////////////////////////////////////////////////////////////////// //
181 {$PUSH}
182 {$RANGECHECKS OFF}
184 begin
191 // already pot?
192 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
194 {$POP}
197 // ////////////////////////////////////////////////////////////////////////// //
201 {$PUSH}
202 {$RANGECHECKS OFF}
204 begin
216 begin
219 {$POP}
223 begin
229 begin
234 // ////////////////////////////////////////////////////////////////////////// //
235 {$PUSH}
236 {$RANGECHECKS OFF}
238 begin
244 begin
250 begin
257 var
260 begin
265 begin
277 begin
283 {$POP}
287 var
289 begin
296 // ////////////////////////////////////////////////////////////////////////// //
297 {$PUSH}
298 {$RANGECHECKS OFF}
299 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
301 var
303 begin
307 begin
314 {$POP}
317 {$PUSH}
318 {$RANGECHECKS OFF}
320 begin
330 {$POP}
333 // ////////////////////////////////////////////////////////////////////////// //
335 begin
336 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
337 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
348 begin
356 var
358 begin
363 {
364 for idx := 0 to High(mEntries)-1 do
365 begin
366 mEntries[idx].hash := 0;
367 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
368 end;
369 mEntries[High(mEntries)].hash := 0;
370 mEntries[High(mEntries)].nextFree := nil;
371 }
372 {
373 for idx := 0 to High(mEntries) do
374 begin
375 mEntries[idx].hash := 0;
376 mEntries[idx].nextFree := nil;
377 end;
378 }
381 {$IFDEF RBHASH_SANITY_CHECKS}
383 {$ENDIF}
391 var
393 begin
395 begin
397 {
398 for idx := 0 to High(mEntries)-1 do
399 begin
400 mEntries[idx].hash := 0;
401 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
402 end;
403 mEntries[High(mEntries)].hash := 0;
404 mEntries[High(mEntries)].nextFree := nil;
405 }
406 {
407 if (mFirstEntry >= 0) then
408 begin
409 for idx := mFirstEntry to mLastEntry do
410 begin
411 mEntries[idx].hash := 0;
412 mEntries[idx].nextFree := nil;
413 end;
414 end;
415 }
418 {$IFDEF RBHASH_SANITY_CHECKS}
420 {$ENDIF}
432 var
434 begin
436 begin
437 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
440 begin
441 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
446 {$IFDEF RBHASH_SANITY_CHECKS}
448 {$ENDIF}
449 exit;
451 {$IFDEF RBHASH_SANITY_CHECKS}
452 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
453 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
454 {$ENDIF}
457 {$IFDEF RBHASH_SANITY_CHECKS}
459 {$ENDIF}
461 // fix mFirstEntry and mLastEntry
463 {$IFDEF RBHASH_SANITY_CHECKS}
464 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
465 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
466 {$ENDIF}
473 var
475 begin
476 {$IFDEF RBHASH_SANITY_CHECKS}
478 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
479 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
480 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
481 {$ENDIF}
483 {$IFDEF RBHASH_SANITY_CHECKS}
484 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
485 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
486 {$ENDIF}
487 {$IFDEF RBHASH_SANITY_CHECKS}
489 {$ENDIF}
493 // fix mFirstEntry and mLastEntry
494 {$IFDEF RBHASH_SANITY_CHECKS}
495 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
496 {$ENDIF}
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; 1)');
501 {$ENDIF}
504 end
505 else
506 begin
507 {$IFDEF RBHASH_SANITY_CHECKS}
508 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
509 {$ENDIF}
510 // fix first entry index
512 begin
515 {$IFDEF RBHASH_SANITY_CHECKS}
516 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
517 {$ENDIF}
520 // fix last entry index
522 begin
525 {$IFDEF RBHASH_SANITY_CHECKS}
526 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
527 {$ENDIF}
534 (*
535 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
536 begin
537 {$IFDEF RBHASH_SANITY_CHECKS}
538 assert(idx < Length(mBuckets));
539 assert(mBuckets[idx] <> nil);
540 {$ENDIF}
541 result := mBuckets[idx].hash and High(mBuckets);
542 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
543 end;
544 *)
548 var
552 begin
562 begin
564 //pdist := distToStIdx(idx);
567 //
577 var
581 begin
591 begin
593 //pdist := distToStIdx(idx);
596 //
600 begin
602 break;
612 var
616 begin
619 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
622 begin
624 begin
625 // put entry
629 break;
631 //pdist := distToStIdx(idx);
634 //
636 begin
637 // swapping the current bucket with the one to insert
650 var
655 begin
662 // check if we already have this key
664 begin
666 begin
668 //pdist := distToStIdx(idx);
671 //
675 begin
676 // replace element
677 //mBuckets[idx].key := akey;
679 exit;
685 // need to resize hash?
687 begin
689 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
691 {$IFDEF RBHASH_DEBUG_RESIZE}
692 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
693 {$ENDIF}
695 // resize entries array
699 // mFreeEntryHead will be fixed in `rehash()`
700 // reinsert entries
702 // as seed was changed, recalc hash
706 // create new entry
716 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
718 var
721 begin
729 // find key
732 begin
734 //pdist := distToStIdx(idxcur);
737 //
745 begin
746 // key not found
747 {$IFDEF RBHASH_DEBUG_DELETE}
749 {$ENDIF}
750 exit;
753 {$IFDEF RBHASH_DEBUG_DELETE}
754 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
755 {$ENDIF}
760 begin
761 {$IFDEF RBHASH_DEBUG_DELETE}
762 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
763 {$ENDIF}
764 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
765 //pdist := distToStIdx(idxnext);
768 //
769 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
781 var
785 {$IFDEF RBHASH_SANITY_CHECKS}
787 {$ENDIF}
788 begin
789 // change seed, to minimize pathological cases
792 // clear buckets
795 // reinsert entries
799 begin
802 begin
803 {$IFDEF RBHASH_SANITY_CHECKS}
805 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
807 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
808 {$ENDIF}
811 end
812 else
813 begin
819 {$IFDEF RBHASH_SANITY_CHECKS}
820 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
821 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
822 {$ENDIF}
827 var
829 {$IFDEF RBHASH_SANITY_CHECKS}
831 {$ENDIF}
832 begin
837 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
839 // move all entries to top
841 begin
842 {$IFDEF RBHASH_SANITY_CHECKS}
843 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
844 {$ENDIF}
848 // copy entries
850 begin
852 begin
853 {$IFDEF RBHASH_SANITY_CHECKS}
855 {$ENDIF}
864 {$IFDEF RBHASH_SANITY_CHECKS}
865 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
866 {$ENDIF}
869 {$IFDEF RBHASH_SANITY_CHECKS}
872 begin
873 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
876 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
877 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
879 begin
880 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
882 {$ENDIF}
883 end
884 else
885 begin
886 {$IFDEF RBHASH_SANITY_CHECKS}
887 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
888 {$ENDIF}
890 // shrink
893 // mFreeEntryHead will be fixed in `rehash()`
894 // reinsert entries
900 var
902 begin
908 begin
910 begin
919 // enumerators
921 begin
922 if (Length(mEntries) > 0) then result := TValEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
927 begin
928 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
933 begin
934 if (Length(mEntries) > 0) then result := TValEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
939 begin
940 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
945 // ////////////////////////////////////////////////////////////////////////// //
947 begin
955 begin
958 begin
965 begin
970 // ////////////////////////////////////////////////////////////////////////// //
972 begin
980 begin
983 begin
990 begin
995 // ////////////////////////////////////////////////////////////////////////// //
997 begin
1005 begin
1008 begin
1015 begin