{ This file is part of the Free Pascal FCL library. BSD parts (c) 2011 Vlado Boza See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$mode objfpc} unit ghashmap; interface uses gvector, gutil, garrayutils; const baseFDataSize = 8; {Thash should have one class function hash(a:TKey, n:longint):longint which return uniformly distributed value in range <0,n-1> base only on arguments, n will be always power of 2} type generic THashmapIterator=class public type PValue=^TValue; var Fh,Fp:SizeUInt; FData:TTable; function Next:boolean;inline; function GetData:T;inline; function GetKey:TKey;inline; function GetValue:TValue;inline; function GetMutable:PValue;inline; procedure SetValue(value:TValue);inline; property Data:T read GetData; property Key:TKey read GetKey; property Value:TValue read GetValue write SetValue; property MutableValue:PValue read GetMutable; end; generic THashmap=class public type TPair=record Value:TValue; Key:TKey; end; var private type TContainer = specialize TVector; TTable = specialize TVector; var FData:TTable; FDataSize:SizeUInt; procedure EnlargeTable; public type TIterator = specialize THashmapIterator; constructor create; destructor destroy;override; procedure insert(key:TKey;value:TValue);inline; function contains(key:TKey):boolean;inline; function size:SizeUInt;inline; procedure delete(key:TKey);inline; function IsEmpty:boolean;inline; function GetData(key:TKey):TValue;inline; property Items[i : TKey]: TValue read GetData write Insert; default; function Iterator:TIterator; end; implementation function THashmap.Size:SizeUInt;inline; begin Size:=FDataSize; end; destructor THashmap.Destroy; var i:SizeUInt; begin for i:=0 to FData.size-1 do (FData[i]).Destroy; FData.Destroy; end; function THashmap.IsEmpty():boolean;inline; begin if Size()=0 then IsEmpty:=true else IsEmpty:=false; end; procedure THashmap.EnlargeTable; var i,j,h,oldDataSize:SizeUInt; value:TPair; begin oldDataSize:=FData.size; FData.resize(FData.size*2); for i:=oldDataSize to FData.size-1 do FData[i] := TContainer.create; for i:=oldDataSize-1 downto 0 do begin j := 0; while j < (FData[i]).size do begin value := (FData[i])[j]; h:=Thash.hash(value.key,FData.size); if (h <> i) then begin (FData[i])[j] := (FData[i]).back; (FData[i]).popback; (FData[h]).pushback(value); end else inc(j); end; end; end; constructor THashmap.create; var i:longint; begin FDataSize:=0; FData:=TTable.create; FData.resize(baseFDataSize); for i:=0 to baseFDataSize-1 do FData[i]:=TContainer.create; end; function THashmap.contains(key:TKey):boolean;inline; var i,h,bs:longint; begin h:=Thash.hash(key,FData.size); bs:=(FData[h]).size; for i:=0 to bs-1 do begin if (((FData[h])[i]).Key=key) then exit(true); end; exit(false); end; function THashmap.GetData(key:TKey):TValue;inline; var i,h,bs:longint; begin h:=Thash.hash(key,FData.size); bs:=(FData[h]).size; for i:=0 to bs-1 do begin if (((FData[h])[i]).Key=key) then exit(((FData[h])[i]).Value); end; end; procedure THashmap.insert(key:TKey;value:TValue);inline; var pair:TPair; i,h,bs:longint; begin h:=Thash.hash(key,FData.size); bs:=(FData[h]).size; for i:=0 to bs-1 do begin if (((FData[h])[i]).Key=key) then begin ((FData[h]).mutable[i])^.value := value; exit; end; end; pair.Key := key; pair.Value := value; inc(FDataSize); (FData[h]).pushback(pair); if (FDataSize > 5*FData.size) then EnlargeTable; end; procedure THashmap.delete(key:TKey);inline; var h,i:SizeUInt; begin h:=Thash.hash(key,FData.size); i:=0; while i < (FData[h]).size do begin if (((FData[h])[i]).key=key) then begin (FData[h])[i] := (FData[h]).back; (FData[h]).popback; dec(FDataSize); exit; end; inc(i); end; end; function THashmapIterator.Next:boolean; begin inc(Fp); if (Fp = (FData[Fh]).size) then begin Fp:=0; inc(Fh); while Fh < FData.size do begin if ((FData[Fh]).size > 0) then break; inc(Fh); end; if (Fh = FData.size) then exit(false); end; Next := true; end; function THashmapIterator.GetData:T; begin GetData:=(FData[Fh])[Fp]; end; function THashmap.Iterator:TIterator; var h,p:SizeUInt; begin h:=0; p:=0; while h < FData.size do begin if ((FData[h]).size > 0) then break; inc(h); end; if (h = FData.size) then exit(nil); Iterator := TIterator.create; Iterator.Fh := h; Iterator.Fp := p; Iterator.FData := FData; end; function THashmapIterator.GetKey:TKey;inline; begin GetKey:=((FData[Fh])[Fp]).Key; end; function THashmapIterator.GetValue:TValue;inline; begin GetValue:=((FData[Fh])[Fp]).Value; end; function THashmapIterator.GetMutable:PValue;inline; begin GetMutable:=@((FData[Fh]).Mutable[Fp]^.Value); end; procedure THashmapIterator.SetValue(value:TValue);inline; begin ((FData[Fh]).mutable[Fp])^.Value := value; end; end.