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
90 //WARNING! don't modify table in iterator (queries are ok, though)
98 type
100 private
104 public
112 // current hash value
113 // you can continue putting data, as this is not destructive
118 type
131 implementation
133 uses
134 SysUtils;
137 // ////////////////////////////////////////////////////////////////////////// //
138 {$PUSH}
139 {$RANGECHECKS OFF}
141 begin
148 // already pot?
149 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
151 {$POP}
154 // ////////////////////////////////////////////////////////////////////////// //
157 {$PUSH}
158 {$RANGECHECKS OFF}
160 begin
170 {$POP}
174 begin
179 // ////////////////////////////////////////////////////////////////////////// //
180 {$PUSH}
181 {$RANGECHECKS OFF}
183 begin
189 begin
195 begin
202 var
205 begin
210 begin
222 begin
228 {$POP}
232 var
234 begin
241 // ////////////////////////////////////////////////////////////////////////// //
242 {$PUSH}
243 {$RANGECHECKS OFF}
244 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
246 var
248 begin
252 begin
259 {$POP}
262 {$PUSH}
263 {$RANGECHECKS OFF}
265 begin
275 {$POP}
278 // ////////////////////////////////////////////////////////////////////////// //
280 begin
281 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
282 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
293 begin
301 var
303 begin
309 begin
317 {$IFDEF RBHASH_SANITY_CHECKS}
319 {$ENDIF}
327 var
329 begin
331 begin
334 begin
342 {$IFDEF RBHASH_SANITY_CHECKS}
344 {$ENDIF}
356 var
358 begin
359 {$IFDEF RBHASH_SANITY_CHECKS}
360 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
361 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
362 {$ENDIF}
365 {$IFDEF RBHASH_SANITY_CHECKS}
367 {$ENDIF}
369 // fix mFirstEntry and mLastEntry
371 {$IFDEF RBHASH_SANITY_CHECKS}
372 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
373 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
374 {$ENDIF}
381 var
383 begin
384 {$IFDEF RBHASH_SANITY_CHECKS}
386 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
387 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
388 if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
389 {$ENDIF}
391 {$IFDEF RBHASH_SANITY_CHECKS}
392 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
393 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
394 {$ENDIF}
398 {$IFDEF RBHASH_SANITY_CHECKS}
400 {$ENDIF}
401 // fix mFirstEntry and mLastEntry
402 {$IFDEF RBHASH_SANITY_CHECKS}
403 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
404 {$ENDIF}
406 begin
407 {$IFDEF RBHASH_SANITY_CHECKS}
408 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
409 {$ENDIF}
412 end
413 else
414 begin
415 {$IFDEF RBHASH_SANITY_CHECKS}
416 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
417 {$ENDIF}
418 // fix first entry index
420 begin
423 {$IFDEF RBHASH_SANITY_CHECKS}
424 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
425 {$ENDIF}
428 // fix last entry index
430 begin
433 {$IFDEF RBHASH_SANITY_CHECKS}
434 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
435 {$ENDIF}
442 (*
443 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
444 begin
445 {$IFDEF RBHASH_SANITY_CHECKS}
446 assert(idx < Length(mBuckets));
447 assert(mBuckets[idx] <> nil);
448 {$ENDIF}
449 result := mBuckets[idx].hash and High(mBuckets);
450 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
451 end;
452 *)
456 var
460 begin
470 begin
472 //pdist := distToStIdx(idx);
475 //
485 var
489 begin
499 begin
501 //pdist := distToStIdx(idx);
504 //
508 begin
510 break;
520 var
524 begin
527 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
530 begin
532 begin
533 // put entry
537 break;
539 //pdist := distToStIdx(idx);
542 //
544 begin
545 // swapping the current bucket with the one to insert
558 var
563 begin
570 // check if we already have this key
572 begin
574 begin
576 //pdist := distToStIdx(idx);
579 //
583 begin
584 // replace element
585 //mBuckets[idx].key := akey;
587 exit;
593 // need to resize hash?
595 begin
597 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
599 {$IFDEF RBHASH_DEBUG_RESIZE}
600 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
601 {$ENDIF}
603 // resize entries array
607 // mFreeEntryHead will be fixed in `rehash()`
608 // reinsert entries
610 // as seed was changed, recalc hash
614 // create new entry
624 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
626 var
629 begin
637 // find key
640 begin
642 //pdist := distToStIdx(idxcur);
645 //
653 begin
654 // key not found
655 {$IFDEF RBHASH_DEBUG_DELETE}
657 {$ENDIF}
658 exit;
661 {$IFDEF RBHASH_DEBUG_DELETE}
662 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
663 {$ENDIF}
668 begin
669 {$IFDEF RBHASH_DEBUG_DELETE}
670 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
671 {$ENDIF}
672 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
673 //pdist := distToStIdx(idxnext);
676 //
677 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
689 var
693 {$IFDEF RBHASH_SANITY_CHECKS}
695 {$ENDIF}
696 begin
697 // change seed, to minimize pathological cases
700 // clear buckets
703 // reinsert entries
707 begin
710 begin
711 {$IFDEF RBHASH_SANITY_CHECKS}
713 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
715 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
716 {$ENDIF}
719 end
720 else
721 begin
727 {$IFDEF RBHASH_SANITY_CHECKS}
728 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
729 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
730 {$ENDIF}
735 var
737 {$IFDEF RBHASH_SANITY_CHECKS}
739 {$ENDIF}
740 begin
745 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
747 // move all entries to top
749 begin
750 {$IFDEF RBHASH_SANITY_CHECKS}
751 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
752 {$ENDIF}
756 // copy entries
758 begin
760 begin
761 {$IFDEF RBHASH_SANITY_CHECKS}
763 {$ENDIF}
772 {$IFDEF RBHASH_SANITY_CHECKS}
773 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
774 {$ENDIF}
777 {$IFDEF RBHASH_SANITY_CHECKS}
780 begin
781 if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
784 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
785 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
787 begin
788 if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
790 {$ENDIF}
791 end
792 else
793 begin
794 {$IFDEF RBHASH_SANITY_CHECKS}
795 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
796 {$ENDIF}
798 // shrink
801 // mFreeEntryHead will be fixed in `rehash()`
802 // reinsert entries
808 var
810 begin
816 begin
818 begin