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 private
43 type
53 private
56 public
63 private
69 {$IFDEF RBHASH_SANITY_CHECKS}
71 {$ENDIF}
76 private
80 //function distToStIdx (idx: LongWord): LongWord; inline;
86 public
101 //WARNING! don't modify table in iterator (queries are ok, though)
110 type
112 private
116 public
124 // current hash value
125 // you can continue putting data, as this is not destructive
130 type
143 implementation
145 uses
146 SysUtils;
149 // ////////////////////////////////////////////////////////////////////////// //
150 {$PUSH}
151 {$RANGECHECKS OFF}
153 begin
160 // already pot?
161 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
163 {$POP}
166 // ////////////////////////////////////////////////////////////////////////// //
169 {$PUSH}
170 {$RANGECHECKS OFF}
172 begin
182 {$POP}
186 begin
191 // ////////////////////////////////////////////////////////////////////////// //
192 {$PUSH}
193 {$RANGECHECKS OFF}
195 begin
201 begin
207 begin
214 var
217 begin
222 begin
234 begin
240 {$POP}
244 var
246 begin
253 // ////////////////////////////////////////////////////////////////////////// //
254 {$PUSH}
255 {$RANGECHECKS OFF}
256 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
258 var
260 begin
264 begin
271 {$POP}
274 {$PUSH}
275 {$RANGECHECKS OFF}
277 begin
287 {$POP}
290 // ////////////////////////////////////////////////////////////////////////// //
292 begin
293 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
294 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
305 begin
313 var
315 begin
320 {
321 for idx := 0 to High(mEntries)-1 do
322 begin
323 mEntries[idx].hash := 0;
324 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
325 end;
326 mEntries[High(mEntries)].hash := 0;
327 mEntries[High(mEntries)].nextFree := nil;
328 }
329 {
330 for idx := 0 to High(mEntries) do
331 begin
332 mEntries[idx].hash := 0;
333 mEntries[idx].nextFree := nil;
334 end;
335 }
338 {$IFDEF RBHASH_SANITY_CHECKS}
340 {$ENDIF}
348 var
350 begin
352 begin
354 {
355 for idx := 0 to High(mEntries)-1 do
356 begin
357 mEntries[idx].hash := 0;
358 mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
359 end;
360 mEntries[High(mEntries)].hash := 0;
361 mEntries[High(mEntries)].nextFree := nil;
362 }
363 {
364 if (mFirstEntry >= 0) then
365 begin
366 for idx := mFirstEntry to mLastEntry do
367 begin
368 mEntries[idx].hash := 0;
369 mEntries[idx].nextFree := nil;
370 end;
371 end;
372 }
375 {$IFDEF RBHASH_SANITY_CHECKS}
377 {$ENDIF}
389 var
391 begin
393 begin
394 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
397 begin
398 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
403 {$IFDEF RBHASH_SANITY_CHECKS}
405 {$ENDIF}
406 exit;
408 {$IFDEF RBHASH_SANITY_CHECKS}
409 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
410 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
411 {$ENDIF}
414 {$IFDEF RBHASH_SANITY_CHECKS}
416 {$ENDIF}
418 // fix mFirstEntry and mLastEntry
420 {$IFDEF RBHASH_SANITY_CHECKS}
421 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
422 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
423 {$ENDIF}
430 var
432 begin
433 {$IFDEF RBHASH_SANITY_CHECKS}
435 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
436 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
437 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
438 {$ENDIF}
440 {$IFDEF RBHASH_SANITY_CHECKS}
441 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
442 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
443 {$ENDIF}
444 {$IFDEF RBHASH_SANITY_CHECKS}
446 {$ENDIF}
450 // fix mFirstEntry and mLastEntry
451 {$IFDEF RBHASH_SANITY_CHECKS}
452 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
453 {$ENDIF}
455 begin
456 {$IFDEF RBHASH_SANITY_CHECKS}
457 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
458 {$ENDIF}
461 end
462 else
463 begin
464 {$IFDEF RBHASH_SANITY_CHECKS}
465 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
466 {$ENDIF}
467 // fix first entry index
469 begin
472 {$IFDEF RBHASH_SANITY_CHECKS}
473 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
474 {$ENDIF}
477 // fix last entry index
479 begin
482 {$IFDEF RBHASH_SANITY_CHECKS}
483 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
484 {$ENDIF}
491 (*
492 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
493 begin
494 {$IFDEF RBHASH_SANITY_CHECKS}
495 assert(idx < Length(mBuckets));
496 assert(mBuckets[idx] <> nil);
497 {$ENDIF}
498 result := mBuckets[idx].hash and High(mBuckets);
499 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
500 end;
501 *)
505 var
509 begin
519 begin
521 //pdist := distToStIdx(idx);
524 //
534 var
538 begin
548 begin
550 //pdist := distToStIdx(idx);
553 //
557 begin
559 break;
569 var
573 begin
576 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
579 begin
581 begin
582 // put entry
586 break;
588 //pdist := distToStIdx(idx);
591 //
593 begin
594 // swapping the current bucket with the one to insert
607 var
612 begin
619 // check if we already have this key
621 begin
623 begin
625 //pdist := distToStIdx(idx);
628 //
632 begin
633 // replace element
634 //mBuckets[idx].key := akey;
636 exit;
642 // need to resize hash?
644 begin
646 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
648 {$IFDEF RBHASH_DEBUG_RESIZE}
649 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
650 {$ENDIF}
652 // resize entries array
656 // mFreeEntryHead will be fixed in `rehash()`
657 // reinsert entries
659 // as seed was changed, recalc hash
663 // create new entry
673 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
675 var
678 begin
686 // find key
689 begin
691 //pdist := distToStIdx(idxcur);
694 //
702 begin
703 // key not found
704 {$IFDEF RBHASH_DEBUG_DELETE}
706 {$ENDIF}
707 exit;
710 {$IFDEF RBHASH_DEBUG_DELETE}
711 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
712 {$ENDIF}
717 begin
718 {$IFDEF RBHASH_DEBUG_DELETE}
719 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
720 {$ENDIF}
721 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
722 //pdist := distToStIdx(idxnext);
725 //
726 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
738 var
742 {$IFDEF RBHASH_SANITY_CHECKS}
744 {$ENDIF}
745 begin
746 // change seed, to minimize pathological cases
749 // clear buckets
752 // reinsert entries
756 begin
759 begin
760 {$IFDEF RBHASH_SANITY_CHECKS}
762 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
764 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
765 {$ENDIF}
768 end
769 else
770 begin
776 {$IFDEF RBHASH_SANITY_CHECKS}
777 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
778 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
779 {$ENDIF}
784 var
786 {$IFDEF RBHASH_SANITY_CHECKS}
788 {$ENDIF}
789 begin
794 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
796 // move all entries to top
798 begin
799 {$IFDEF RBHASH_SANITY_CHECKS}
800 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
801 {$ENDIF}
805 // copy entries
807 begin
809 begin
810 {$IFDEF RBHASH_SANITY_CHECKS}
812 {$ENDIF}
821 {$IFDEF RBHASH_SANITY_CHECKS}
822 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
823 {$ENDIF}
826 {$IFDEF RBHASH_SANITY_CHECKS}
829 begin
830 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
833 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
834 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
836 begin
837 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
839 {$ENDIF}
840 end
841 else
842 begin
843 {$IFDEF RBHASH_SANITY_CHECKS}
844 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
845 {$ENDIF}
847 // shrink
850 // mFreeEntryHead will be fixed in `rehash()`
851 // reinsert entries
857 var
859 begin
865 begin
867 begin
877 begin
879 begin
881 end
882 else
883 begin
889 begin
897 begin
900 begin
907 begin