c649347fbd1b1e87776b961b951d92112ade16e4
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
41 private
42 type
51 private
61 private
65 //function distToStIdx (idx: LongWord): LongWord; inline;
71 public
90 type
92 private
96 public
104 // current hash value
105 // you can continue putting data, as this is not destructive
110 type
123 implementation
125 uses
126 SysUtils;
129 // ////////////////////////////////////////////////////////////////////////// //
130 {$PUSH}
131 {$RANGECHECKS OFF}
133 begin
140 // already pot?
141 if (x <> 0) and ((x and (x-1)) = 0) then result := result and (not (result shr 1)) else result += 1;
143 {$POP}
146 // ////////////////////////////////////////////////////////////////////////// //
149 {$PUSH}
150 {$RANGECHECKS OFF}
152 begin
162 {$POP}
166 begin
171 // ////////////////////////////////////////////////////////////////////////// //
172 {$PUSH}
173 {$RANGECHECKS OFF}
175 begin
181 begin
187 begin
194 var
197 begin
202 begin
214 begin
220 {$POP}
224 var
226 begin
233 // ////////////////////////////////////////////////////////////////////////// //
234 {$PUSH}
235 {$RANGECHECKS OFF}
236 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
238 var
240 begin
244 begin
251 {$POP}
254 {$PUSH}
255 {$RANGECHECKS OFF}
257 begin
267 {$POP}
270 // ////////////////////////////////////////////////////////////////////////// //
272 begin
273 if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
274 if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
285 begin
296 begin
297 {$IFDEF RBHASH_SANITY_CHECKS}
298 if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
299 if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
300 {$ENDIF}
309 //var
310 // idx: LongWord;
311 begin
312 {$IFDEF RBHASH_SANITY_CHECKS}
314 if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
315 if (e.nextFree <> nil) or (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
316 {$ENDIF}
317 //idx := LongWord((PtrUInt(e)-PtrUInt(@mEntries[0])) div sizeof(mEntries[0]));
318 {$IFDEF RBHASH_SANITY_CHECKS}
319 //if (idx >= Length(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid calculated index)');
320 {$ENDIF}
328 (*
329 function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
330 begin
331 {$IFDEF RBHASH_SANITY_CHECKS}
332 assert(idx < Length(mBuckets));
333 assert(mBuckets[idx] <> nil);
334 {$ENDIF}
335 result := mBuckets[idx].hash and High(mBuckets);
336 if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
337 end;
338 *)
342 var
346 begin
356 begin
358 //pdist := distToStIdx(idx);
361 //
371 var
375 begin
385 begin
387 //pdist := distToStIdx(idx);
390 //
394 begin
396 break;
406 var
410 begin
413 {$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
416 begin
418 begin
419 // put entry
423 break;
425 //pdist := distToStIdx(idx);
428 //
430 begin
431 // swapping the current bucket with the one to insert
444 var
449 begin
456 // check if we already have this key
458 begin
460 begin
462 //pdist := distToStIdx(idx);
465 //
469 begin
470 // replace element
471 //mBuckets[idx].key := akey;
473 exit;
479 // need to resize hash?
481 begin
483 if (Length(mEntries) <> newsz) then raise Exception.Create('internal error in hash table (resize)');
485 {$IFDEF RBHASH_DEBUG_RESIZE}
486 writeln('resizing hash; used=', mBucketsUsed, '; total=', (bhigh+1), '; maxload=', (bhigh+1)*LoadFactorPrc div 100, '; newsz=', newsz);
487 {$ENDIF}
489 // resize entries array
493 // mFreeEntryHead will be fixed in `rehash()`
494 // reinsert entries
496 // as seed was changed, recalc hash
500 // create new entry
510 // see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
512 var
515 begin
523 // find key
526 begin
528 //pdist := distToStIdx(idxcur);
531 //
539 begin
540 // key not found
541 {$IFDEF RBHASH_DEBUG_DELETE}
543 {$ENDIF}
544 exit;
547 {$IFDEF RBHASH_DEBUG_DELETE}
548 writeln('del: key ', akey, ': found at ', idx, '; ek=', mBuckets[idx].key, '; ev=', mBuckets[idx].value);
549 {$ENDIF}
554 begin
555 {$IFDEF RBHASH_DEBUG_DELETE}
556 writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
557 {$ENDIF}
558 if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
559 //pdist := distToStIdx(idxnext);
562 //
563 if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
575 var
577 begin
583 begin
597 var
601 begin
602 // change seed, to minimize pathological cases
605 // clear buckets
608 // reinsert entries
612 begin
615 begin
618 end
619 else
620 begin
629 var
631 begin
636 {$IFDEF RBHASH_DEBUG_COMPACT}writeln('compacting; used=', mBucketsUsed, '; oldsizePOT=', newsz, '; newsize=', newsz*2);{$ENDIF}
638 // move all entries to top
643 // copy entries
645 begin
647 begin
655 end
656 else
657 begin
661 // shrink
664 // mFreeEntryHead will be fixed in `rehash()`
665 // reinsert entries