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
34 const InitSize = {$IF DEFINED(RBHASH_SANITY_CHECKS)}16{$ELSE}256{$ENDIF}; // *MUST* be power of two
37 public
38 type
41 public
44 private
47 private
49 public
58 type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
59 type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
61 private
62 type
65 public
66 type
68 private
71 public
80 private
83 public
92 private
95 public
103 private
111 {$IFDEF RBHASH_SANITY_CHECKS}
113 {$ENDIF}
118 private
130 public
131 constructor Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
140 // you may pass `keyhash` to bypass hash calculation
141 function get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean; // `true`: found
142 // the function may return calculated value hash in `keyhash`
143 function put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean; // `true`: replaced
144 // you may pass `keyhash` to bypass hash calculation
146 // you may pass `keyhash` to bypass hash calculation
149 //WARNING! don't modify table in iterator (queries are ok, though)
153 // default `for ... in` enums values
163 type
165 private
169 public
177 // current hash value
178 // you can continue putting data, as this is not destructive
183 type
205 // for integer keys
214 implementation
216 uses
220 // ////////////////////////////////////////////////////////////////////////// //
221 {$PUSH}
222 {$RANGECHECKS OFF}
224 begin
231 // already pot?
232 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
234 {$POP}
237 // ////////////////////////////////////////////////////////////////////////// //
243 {$PUSH}
244 {$RANGECHECKS OFF}
246 begin
258 begin
261 {$POP}
265 begin
271 begin
277 begin
283 begin
289 begin
294 // ////////////////////////////////////////////////////////////////////////// //
295 {$PUSH}
296 {$RANGECHECKS OFF}
298 begin
304 begin
310 begin
317 var
320 begin
325 begin
337 begin
343 {$POP}
347 var
349 begin
356 // ////////////////////////////////////////////////////////////////////////// //
357 {$PUSH}
358 {$RANGECHECKS OFF}
359 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
361 var
363 begin
367 begin
374 {$POP}
377 {$PUSH}
378 {$RANGECHECKS OFF}
380 begin
390 {$POP}
393 // ////////////////////////////////////////////////////////////////////////// //
397 // ////////////////////////////////////////////////////////////////////////// //
401 constructor THashBase.Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
402 begin
403 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
404 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
419 begin
427 var
430 begin
432 begin
434 begin
437 begin
445 end
447 begin
453 {$IFDEF RBHASH_SANITY_CHECKS}
455 {$ENDIF}
460 //var idx: Integer;
461 begin
465 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
473 //var idx: Integer;
474 begin
477 begin
478 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
486 var
488 begin
490 begin
491 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
494 begin
495 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
500 {$IFDEF RBHASH_SANITY_CHECKS}
502 {$ENDIF}
503 exit;
505 {$IFDEF RBHASH_SANITY_CHECKS}
506 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
507 if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
508 {$ENDIF}
511 {$IFDEF RBHASH_SANITY_CHECKS}
513 {$ENDIF}
515 // fix mFirstEntry and mLastEntry
517 {$IFDEF RBHASH_SANITY_CHECKS}
518 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
519 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
520 {$ENDIF}
527 var
529 begin
530 {$IFDEF RBHASH_SANITY_CHECKS}
532 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
533 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
534 if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
535 {$ENDIF}
537 {$IFDEF RBHASH_SANITY_CHECKS}
538 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
539 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
540 {$ENDIF}
543 {$IFDEF RBHASH_SANITY_CHECKS}
545 {$ENDIF}
551 // fix mFirstEntry and mLastEntry
552 {$IFDEF RBHASH_SANITY_CHECKS}
553 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
554 {$ENDIF}
556 begin
557 {$IFDEF RBHASH_SANITY_CHECKS}
558 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
559 {$ENDIF}
563 end
564 else
565 begin
566 {$IFDEF RBHASH_SANITY_CHECKS}
567 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
568 {$ENDIF}
569 // fix first entry index
571 begin
574 {$IFDEF RBHASH_SANITY_CHECKS}
575 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
576 {$ENDIF}
579 // fix last entry index
581 begin
584 {$IFDEF RBHASH_SANITY_CHECKS}
585 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
586 {$ENDIF}
594 begin
595 {$IFDEF RBHASH_SANITY_CHECKS}
598 {$ENDIF}
605 var
609 begin
617 begin
620 end
621 else
622 begin
631 begin
642 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
643 var
647 begin
655 begin
658 end
659 else
660 begin
668 begin
682 var
686 begin
690 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
693 begin
695 begin
696 // put entry
700 break;
704 begin
705 // swapping the current bucket with the one to insert
717 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
718 var
723 begin
733 // check if we already have this key
735 begin
737 begin
743 begin
744 // replace element
749 exit;
755 // need to resize hash?
757 begin
759 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
761 {$IFDEF RBHASH_DEBUG_RESIZE}
762 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
763 {$ENDIF}
765 // resize entries array
769 // mFreeEntryHead will be fixed in `rehash()`
770 // reinsert entries
774 // create new entry
784 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
786 var
789 begin
797 begin
800 end
801 else
802 begin
809 // find key
812 begin
822 begin
823 // key not found
824 {$IFDEF RBHASH_DEBUG_DELETE}
826 {$ENDIF}
827 exit;
830 {$IFDEF RBHASH_DEBUG_DELETE}
831 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
832 {$ENDIF}
837 begin
838 {$IFDEF RBHASH_DEBUG_DELETE}
839 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
840 {$ENDIF}
841 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
843 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
855 var
859 {$IFDEF RBHASH_SANITY_CHECKS}
861 {$ENDIF}
862 begin
863 // change seed, to minimize pathological cases
864 //TODO: use prng to generate new hash
867 // clear buckets
868 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
871 // reinsert entries
875 begin
878 begin
879 {$IFDEF RBHASH_SANITY_CHECKS}
881 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
883 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
884 {$ENDIF}
885 // no need to recalculate hash
886 //e.hash := hashfn(e.key) xor mSeed; if (e.hash = 0) then e.hash := $29a;
888 end
889 else
890 begin
896 {$IFDEF RBHASH_SANITY_CHECKS}
897 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
898 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
899 {$ENDIF}
904 var
906 {$IFDEF RBHASH_SANITY_CHECKS}
908 {$ENDIF}
909 begin
914 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
916 // move all entries to top
918 begin
919 {$IFDEF RBHASH_SANITY_CHECKS}
920 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
921 {$ENDIF}
925 // copy entries
927 begin
929 begin
930 {$IFDEF RBHASH_SANITY_CHECKS}
932 {$ENDIF}
941 {$IFDEF RBHASH_SANITY_CHECKS}
942 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
943 {$ENDIF}
946 {$IFDEF RBHASH_SANITY_CHECKS}
949 begin
950 if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
953 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
954 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
956 begin
957 if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
959 {$ENDIF}
960 end
961 else
962 begin
963 {$IFDEF RBHASH_SANITY_CHECKS}
964 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
965 {$ENDIF}
967 // shrink
970 // mFreeEntryHead will be fixed in `rehash()`
971 // reinsert entries
977 var
979 begin
983 begin
985 begin
993 var
995 begin
999 begin
1001 begin
1009 // enumerators
1011 begin
1012 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1017 begin
1018 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1023 begin
1024 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1029 begin
1030 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1035 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1036 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1037 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1040 // ////////////////////////////////////////////////////////////////////////// //
1041 constructor THashBase.TValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1042 begin
1050 begin
1053 begin
1060 begin
1065 // ////////////////////////////////////////////////////////////////////////// //
1066 constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1067 begin
1075 begin
1078 begin
1085 begin
1090 // ////////////////////////////////////////////////////////////////////////// //
1091 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1092 begin
1100 begin
1103 begin
1110 begin