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
52 private
58 {$IFDEF RBHASH_SANITY_CHECKS}
60 {$ENDIF}
65 private
69 //function distToStIdx (idx: LongWord): LongWord; inline;
75 public
89 //WARNING! don't modify table in iterator (queries are ok, though)
97 type
99 private
103 public
111 // current hash value
112 // you can continue putting data, as this is not destructive
117 type
130 implementation
132 uses
133 SysUtils;
136 // ////////////////////////////////////////////////////////////////////////// //
137 {$PUSH}
138 {$RANGECHECKS OFF}
140 begin
147 // already pot?
148 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
150 {$POP}
153 // ////////////////////////////////////////////////////////////////////////// //
156 {$PUSH}
157 {$RANGECHECKS OFF}
159 begin
169 {$POP}
173 begin
178 // ////////////////////////////////////////////////////////////////////////// //
179 {$PUSH}
180 {$RANGECHECKS OFF}
182 begin
188 begin
194 begin
201 var
204 begin
209 begin
221 begin
227 {$POP}
231 var
233 begin
240 // ////////////////////////////////////////////////////////////////////////// //
241 {$PUSH}
242 {$RANGECHECKS OFF}
243 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
245 var
247 begin
251 begin
258 {$POP}
261 {$PUSH}
262 {$RANGECHECKS OFF}
264 begin
274 {$POP}
277 // ////////////////////////////////////////////////////////////////////////// //
279 begin
280 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
281 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
292 begin
300 var
302 begin
308 begin
316 {$IFDEF RBHASH_SANITY_CHECKS}
318 {$ENDIF}
329 var
331 begin
332 {$IFDEF RBHASH_SANITY_CHECKS}
333 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
334 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
335 {$ENDIF}
338 {$IFDEF RBHASH_SANITY_CHECKS}
340 {$ENDIF}
342 // fix mFirstEntry and mLastEntry
344 {$IFDEF RBHASH_SANITY_CHECKS}
345 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
346 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
347 {$ENDIF}
354 var
356 begin
357 {$IFDEF RBHASH_SANITY_CHECKS}
359 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
360 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
361 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
362 {$ENDIF}
364 {$IFDEF RBHASH_SANITY_CHECKS}
365 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
366 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
367 {$ENDIF}
371 {$IFDEF RBHASH_SANITY_CHECKS}
373 {$ENDIF}
374 // fix mFirstEntry and mLastEntry
375 {$IFDEF RBHASH_SANITY_CHECKS}
376 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
377 {$ENDIF}
379 begin
380 {$IFDEF RBHASH_SANITY_CHECKS}
381 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
382 {$ENDIF}
385 end
386 else
387 begin
388 {$IFDEF RBHASH_SANITY_CHECKS}
389 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
390 {$ENDIF}
391 // fix first entry index
393 begin
396 {$IFDEF RBHASH_SANITY_CHECKS}
397 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
398 {$ENDIF}
401 // fix last entry index
403 begin
406 {$IFDEF RBHASH_SANITY_CHECKS}
407 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
408 {$ENDIF}
415 (*
416 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
417 begin
418 {$IFDEF RBHASH_SANITY_CHECKS}
419 assert(idx < Length(mBuckets));
420 assert(mBuckets[idx] <> nil);
421 {$ENDIF}
422 result := mBuckets[idx].hash and High(mBuckets);
423 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
424 end;
425 *)
429 var
433 begin
443 begin
445 //pdist := distToStIdx(idx);
448 //
458 var
462 begin
472 begin
474 //pdist := distToStIdx(idx);
477 //
481 begin
483 break;
493 var
497 begin
500 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
503 begin
505 begin
506 // put entry
510 break;
512 //pdist := distToStIdx(idx);
515 //
517 begin
518 // swapping the current bucket with the one to insert
531 var
536 begin
543 // check if we already have this key
545 begin
547 begin
549 //pdist := distToStIdx(idx);
552 //
556 begin
557 // replace element
558 //mBuckets[idx].key := akey;
560 exit;
566 // need to resize hash?
568 begin
570 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
572 {$IFDEF RBHASH_DEBUG_RESIZE}
573 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
574 {$ENDIF}
576 // resize entries array
580 // mFreeEntryHead will be fixed in `rehash()`
581 // reinsert entries
583 // as seed was changed, recalc hash
587 // create new entry
597 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
599 var
602 begin
610 // find key
613 begin
615 //pdist := distToStIdx(idxcur);
618 //
626 begin
627 // key not found
628 {$IFDEF RBHASH_DEBUG_DELETE}
630 {$ENDIF}
631 exit;
634 {$IFDEF RBHASH_DEBUG_DELETE}
635 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
636 {$ENDIF}
641 begin
642 {$IFDEF RBHASH_DEBUG_DELETE}
643 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
644 {$ENDIF}
645 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
646 //pdist := distToStIdx(idxnext);
649 //
650 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
662 var
666 {$IFDEF RBHASH_SANITY_CHECKS}
668 {$ENDIF}
669 begin
670 // change seed, to minimize pathological cases
673 // clear buckets
676 // reinsert entries
680 begin
683 begin
684 {$IFDEF RBHASH_SANITY_CHECKS}
686 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
688 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
689 {$ENDIF}
692 end
693 else
694 begin
700 {$IFDEF RBHASH_SANITY_CHECKS}
701 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
702 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
703 {$ENDIF}
708 var
710 {$IFDEF RBHASH_SANITY_CHECKS}
712 {$ENDIF}
713 begin
718 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
720 // move all entries to top
722 begin
723 {$IFDEF RBHASH_SANITY_CHECKS}
724 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
725 {$ENDIF}
729 // copy entries
731 begin
733 begin
734 {$IFDEF RBHASH_SANITY_CHECKS}
736 {$ENDIF}
745 {$IFDEF RBHASH_SANITY_CHECKS}
746 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
747 {$ENDIF}
750 {$IFDEF RBHASH_SANITY_CHECKS}
753 begin
754 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
757 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
758 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
760 begin
761 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
763 {$ENDIF}
764 end
765 else
766 begin
767 {$IFDEF RBHASH_SANITY_CHECKS}
768 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
769 {$ENDIF}
771 // shrink
774 // mFreeEntryHead will be fixed in `rehash()`
775 // reinsert entries
781 var
783 begin
789 begin
791 begin