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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE a_modes.inc}
16 {.$DEFINE RBHASH_DEBUG_RESIZE}
17 {.$DEFINE RBHASH_DEBUG_INSERT}
18 {.$DEFINE RBHASH_DEBUG_DELETE}
19 {.$DEFINE RBHASH_DEBUG_COMPACT}
20 {$IF DEFINED(D2F_DEBUG)}
21 {.$DEFINE RBHASH_SANITY_CHECKS}
22 {$ENDIF}
23 // hash table (robin hood)
26 interface
28 (*
29 * HashObjT: class that contains class methods:
30 * class function hash (const[ref] k: KeyT): LongWord;
31 * class function equ (const[ref] a, b: KeyT): Boolean;
32 * class procedure freekey (var k: KeyT); // this may free key
33 *)
34 type
35 // WARNING! don't put structures into hash, use ponters or ids!
37 private
38 const InitSize = {$IF DEFINED(RBHASH_SANITY_CHECKS)}16{$ELSE}256{$ENDIF}; // *MUST* be power of two
41 public
42 type
45 public
48 private
51 private
53 public
59 type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
60 type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
62 private
63 type
66 public
67 type
69 private
72 public
81 private
84 public
93 private
96 public
104 private
109 {$IFDEF RBHASH_SANITY_CHECKS}
111 {$ENDIF}
116 private
128 public
138 // you may pass `keyhash` to bypass hash calculation
139 function get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean; // `true`: found
140 // the function may return calculated value hash in `keyhash`
141 function put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean; // `true`: replaced
142 // you may pass `keyhash` to bypass hash calculation
144 // you may pass `keyhash` to bypass hash calculation
147 //WARNING! don't modify table in iterator (queries are ok, though)
151 // default `for ... in` enums values
161 type
163 private
167 public
175 // current hash value
176 // you can continue putting data, as this is not destructive
181 type
183 public
190 public
196 // case-insensitive (ansi)
198 public
204 type
216 // has to be public due to FPC generics limitation
220 implementation
222 uses
226 // ////////////////////////////////////////////////////////////////////////// //
227 {$PUSH}
228 {$RANGECHECKS OFF}
230 begin
237 // already pot?
238 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
240 {$POP}
243 // ////////////////////////////////////////////////////////////////////////// //
244 {$PUSH}
245 {$RANGECHECKS OFF}
247 begin
252 begin
257 begin
263 var
266 begin
271 begin
282 begin
288 {$POP}
291 // ////////////////////////////////////////////////////////////////////////// //
292 {$PUSH}
293 {$RANGECHECKS OFF}
295 var
298 begin
302 begin
308 // finalize
313 {$POP}
315 {$PUSH}
316 {$RANGECHECKS OFF}
317 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
319 var
321 begin
325 begin
332 {$POP}
334 {$PUSH}
335 {$RANGECHECKS OFF}
337 begin
347 {$POP}
350 begin
352 begin
354 end
355 else
356 begin
358 begin
360 end
361 else
362 begin
373 // ////////////////////////////////////////////////////////////////////////// //
374 // THashKeyInt
376 begin
387 class function THashKeyInt.equ (const a, b: Integer): Boolean; inline; begin result := (a = b); end;
391 // ////////////////////////////////////////////////////////////////////////// //
392 // THashKeyStr
393 class function THashKeyStr.hash (const k: AnsiString): LongWord; inline; begin if (Length(k) > 0) then result := fnvHash((@k[1])^, Length(k)) else result := 0; end;
394 class function THashKeyStr.equ (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
398 // ////////////////////////////////////////////////////////////////////////// //
399 // case-insensitive (ansi)
400 {$PUSH}
401 {$RANGECHECKS OFF}
402 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
404 var
406 begin
410 begin
417 {$POP}
419 class function THashKeyStrAnsiCI.hash (const k: AnsiString): LongWord; inline; begin if (Length(k) > 0) then result := fnvHash((@k[1])^, Length(k)) else result := 0; end;
421 var
423 begin
426 begin
434 // ////////////////////////////////////////////////////////////////////////// //
438 // ////////////////////////////////////////////////////////////////////////// //
443 begin
455 begin
464 var
467 begin
469 begin
471 begin
474 begin
482 end
484 begin
490 {$IFDEF RBHASH_SANITY_CHECKS}
492 {$ENDIF}
497 begin
499 {
500 SetLength(mBuckets, InitSize);
501 FillChar(mBuckets[0], InitSize*sizeof(mBuckets[0]), 0);
502 SetLength(mEntries, InitSize);
503 FillChar(mEntries[0], InitSize*sizeof(mEntries[0]), 0);
504 }
515 //var idx: Integer;
516 begin
519 begin
520 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
528 var
530 begin
532 begin
533 // nothing was allocated, so allocate something now
535 begin
540 {$IFDEF RBHASH_SANITY_CHECKS}
542 {$ENDIF}
548 if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
551 begin
552 if (mLastEntry <> 0) then raise Exception.Create('internal error in hash entry allocator (0.1)');
557 {$IFDEF RBHASH_SANITY_CHECKS}
559 {$ENDIF}
560 exit;
562 {$IFDEF RBHASH_SANITY_CHECKS}
563 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
564 if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
565 {$ENDIF}
568 {$IFDEF RBHASH_SANITY_CHECKS}
570 {$ENDIF}
572 // fix mFirstEntry and mLastEntry
574 {$IFDEF RBHASH_SANITY_CHECKS}
575 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
576 if (result <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
577 {$ENDIF}
584 var
586 begin
587 {$IFDEF RBHASH_SANITY_CHECKS}
589 if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
590 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
591 if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
592 {$ENDIF}
594 {$IFDEF RBHASH_SANITY_CHECKS}
595 if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
596 if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
597 {$ENDIF}
600 {$IFDEF RBHASH_SANITY_CHECKS}
602 {$ENDIF}
608 // fix mFirstEntry and mLastEntry
609 {$IFDEF RBHASH_SANITY_CHECKS}
610 if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
611 {$ENDIF}
613 begin
614 {$IFDEF RBHASH_SANITY_CHECKS}
615 if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
616 {$ENDIF}
620 end
621 else
622 begin
623 {$IFDEF RBHASH_SANITY_CHECKS}
624 if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 2)');
625 {$ENDIF}
626 // fix first entry index
628 begin
631 {$IFDEF RBHASH_SANITY_CHECKS}
632 if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
633 {$ENDIF}
636 // fix last entry index
638 begin
641 {$IFDEF RBHASH_SANITY_CHECKS}
642 if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
643 {$ENDIF}
651 begin
652 {$IFDEF RBHASH_SANITY_CHECKS}
655 {$ENDIF}
662 var
666 begin
674 begin
677 end
678 else
679 begin
688 begin
699 function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
700 var
704 begin
712 begin
715 end
716 else
717 begin
725 begin
739 var
743 begin
747 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
750 begin
752 begin
753 // put entry
757 break;
761 begin
762 // swapping the current bucket with the one to insert
774 function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
775 var
780 begin
790 // check if we already have this key
792 begin
794 begin
800 begin
801 // replace element
803 if assigned(freevalfn) then freevalfn(mBuckets[idx].value) else mBuckets[idx].value := Default(ValueT);
806 exit;
812 // need to resize hash?
814 begin
816 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
818 {$IFDEF RBHASH_DEBUG_RESIZE}
819 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
820 {$ENDIF}
822 // resize entries array
826 // mFreeEntryHead will be fixed in `rehash()`
827 // reinsert entries
831 // create new entry
841 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
843 var
846 begin
854 begin
857 end
858 else
859 begin
866 // find key
869 begin
879 begin
880 // key not found
881 {$IFDEF RBHASH_DEBUG_DELETE}
883 {$ENDIF}
884 exit;
887 {$IFDEF RBHASH_DEBUG_DELETE}
888 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
889 {$ENDIF}
894 begin
895 {$IFDEF RBHASH_DEBUG_DELETE}
896 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
897 {$ENDIF}
898 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
900 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
912 var
916 {$IFDEF RBHASH_SANITY_CHECKS}
918 {$ENDIF}
919 begin
920 // change seed, to minimize pathological cases
921 //TODO: use prng to generate new hash
924 // clear buckets
925 //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
928 // reinsert entries
932 begin
935 begin
936 {$IFDEF RBHASH_SANITY_CHECKS}
938 if (cnt = 0) and (idx <> mFirstEntry) then raise Exception.Create('internal error in rehash: inconsistent (1)');
940 if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
941 {$ENDIF}
942 // no need to recalculate hash
944 end
945 else
946 begin
952 {$IFDEF RBHASH_SANITY_CHECKS}
953 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
954 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');
955 {$ENDIF}
960 var
962 {$IFDEF RBHASH_SANITY_CHECKS}
964 {$ENDIF}
965 begin
970 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
972 // move all entries to top
974 begin
975 {$IFDEF RBHASH_SANITY_CHECKS}
976 if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
977 {$ENDIF}
981 // copy entries
983 begin
985 begin
986 {$IFDEF RBHASH_SANITY_CHECKS}
988 {$ENDIF}
997 {$IFDEF RBHASH_SANITY_CHECKS}
998 if (didx <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 1)');
999 {$ENDIF}
1002 {$IFDEF RBHASH_SANITY_CHECKS}
1005 begin
1006 if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
1009 if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
1010 if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
1012 begin
1013 if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
1015 {$ENDIF}
1016 end
1017 else
1018 begin
1019 {$IFDEF RBHASH_SANITY_CHECKS}
1020 if (mBucketsUsed <> 0) then raise Exception.Create('internal error in hash table (invalid bucket count; 1)');
1021 {$ENDIF}
1023 // shrink
1026 // mFreeEntryHead will be fixed in `rehash()`
1027 // reinsert entries
1033 var
1035 begin
1039 begin
1041 begin
1049 var
1051 begin
1055 begin
1057 begin
1065 // enumerators
1067 begin
1068 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1073 begin
1074 if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1079 begin
1080 if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1085 begin
1086 if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
1091 function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1092 function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1093 function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
1096 // ////////////////////////////////////////////////////////////////////////// //
1097 constructor THashBase.TValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1098 begin
1106 begin
1109 begin
1116 begin
1121 // ////////////////////////////////////////////////////////////////////////// //
1122 constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1123 begin
1131 begin
1134 begin
1141 begin
1146 // ////////////////////////////////////////////////////////////////////////// //
1147 constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
1148 begin
1156 begin
1159 begin
1166 begin