From d30db6fceda041afc2b39e5c230623828ffed677 Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 11 Nov 2005 11:24:30 +0000 Subject: [PATCH] + Added TFPHashTable object, implemented by Dean Zobec git-svn-id: trunk@1721 - --- fcl/inc/contnrs.pp | 432 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 432 insertions(+) diff --git a/fcl/inc/contnrs.pp b/fcl/inc/contnrs.pp index da5ba82cbb..15cabd00b3 100644 --- a/fcl/inc/contnrs.pp +++ b/fcl/inc/contnrs.pp @@ -13,6 +13,7 @@ {$ifdef fpc} {$mode objfpc} {$endif} +{$H+} unit contnrs; interface @@ -20,6 +21,7 @@ interface uses SysUtils,Classes; + Type {$inline on} @@ -62,6 +64,7 @@ Type property List: TFPList read FList; end; + TObjectList = class(TList) private ffreeobjects : boolean; @@ -168,9 +171,103 @@ Type Function Pop: TObject; Function Peek: TObject; end; + +{ --------------------------------------------------------------------- + Hash support, implemented by Dean Zobec + ---------------------------------------------------------------------} + + + { Must return a Longword value in the range 0..TableSize, + usually via a mod operator; } + THashFunction = function(const S: string; const TableSize: Longword): Longword; + + TIteratorMethod = procedure(Item: Pointer; const Key: string; + var Continue: Boolean) of object; + + { THTNode } + + THTNode = class(TObject) + private + FData: pointer; + FKey: string; + public + constructor CreateWith(const AString: String); + function HasKey(const AKey: string): boolean; + property Key: string read FKey; + property Data: pointer read FData write FData; + end; + + { TFPHashTable } + + TFPHashTable = class(TObject) + private + FHashTable: TFPObjectList; + FHashTableSize: Longword; + FHashFunction: THashFunction; + FCount: Int64; + function GetDensity: Longword; + function GetNumberOfCollisions: Int64; + procedure SetHashTableSize(const Value: Longword); + procedure InitializeHashTable; + function GetVoidSlots: Longword; + function GetLoadFactor: double; + function GetAVGChainLen: double; + function GetMaxChainLength: Longword; + function Chain(const index: Longword):TFPObjectList; + protected + function ChainLength(const ChainIndex: Longword): Longword; virtual; + procedure SetData(const index: string; const AValue: Pointer); virtual; + function GetData(const index: string):Pointer; virtual; + function FindOrCreateNew(const aKey: string): THTNode; virtual; + function ForEachCall(aMethod: TIteratorMethod): THTNode; virtual; + procedure SetHashFunction(AHashFunction: THashFunction); virtual; + public + constructor Create; + constructor CreateWith(AHashTableSize: Longword; aHashFunc: THashFunction); + destructor Destroy; override; + procedure ChangeTableSize(const ANewSize: Longword); virtual; + procedure Clear; virtual; + procedure Add(const aKey: string; AItem: pointer); virtual; + procedure Delete(const aKey: string); virtual; + function Find(const aKey: string): THTNode; + function IsEmpty: boolean; + property HashFunction: THashFunction read FHashFunction write SetHashFunction; + property Count: Int64 read FCount; + property HashTableSize: Longword read FHashTableSize write SetHashTableSize; + property Items[const index: string]: Pointer read GetData write SetData; default; + property HashTable: TFPObjectList read FHashTable; + property VoidSlots: Longword read GetVoidSlots; + property LoadFactor: double read GetLoadFactor; + property AVGChainLen: double read GetAVGChainLen; + property MaxChainLength: Int64 read GetMaxChainLength; + property NumberOfCollisions: Int64 read GetNumberOfCollisions; + property Density: Longword read GetDensity; + end; + + EDuplicate = class(Exception); + EKeyNotFound = class(Exception); + + + function RSHash(const S: string; const TableSize: Longword): Longword; implementation +ResourceString + DuplicateMsg = 'An item with key %0:s already exists'; + KeyNotFoundMsg = 'Method: %0:s key [''%1:s''] not found in container'; + NotEmptyMsg = 'Hash table not empty.'; + +const + NPRIMES = 28; + + PRIMELIST: array[0 .. NPRIMES-1] of Longword = + ( 53, 97, 193, 389, 769, + 1543, 3079, 6151, 12289, 24593, + 49157, 98317, 196613, 393241, 786433, + 1572869, 3145739, 6291469, 12582917, 25165843, + 50331653, 100663319, 201326611, 402653189, 805306457, + 1610612741, 3221225473, 4294967291 ); + constructor TFPObjectList.Create(FreeObjects : boolean); begin Create; @@ -709,4 +806,339 @@ begin Result:=TObject(Inherited Push(Pointer(Aobject))); end; +{ --------------------------------------------------------------------- + Hash support, by Dean Zobec + ---------------------------------------------------------------------} + +{ Default hash function } + +function RSHash(const S: string; const TableSize: Longword): Longword; +const + b = 378551; +var + a: Longword; + i: Longword; +begin + a := 63689; + Result := 0; + for i := 1 to Length(S) do + begin + Result := Result * a + Ord(S[i]); + a := a * b; + end; + Result := (Result and $7FFFFFFF) mod TableSize; +end; + +{ THTNode } + +constructor THTNode.CreateWith(const AString: string); +begin + inherited Create; + FKey := AString; +end; + +function THTNode.HasKey(const AKey: string): boolean; +begin + if Length(AKey) <> Length(FKey) then + begin + Result := false; + exit; + end + else + Result := CompareMem(PChar(FKey), PChar(AKey), length(AKey)); +end; + +{ TFPHashTable } + +constructor TFPHashTable.Create; +begin + Inherited Create; + FHashTable := TFPObjectList.Create(True); + HashTableSize := 196613; + FHashFunction := @RSHash; +end; + +constructor TFPHashTable.CreateWith(AHashTableSize: Longword; + aHashFunc: THashFunction); +begin + Inherited Create; + FHashTable := TFPObjectList.Create(True); + HashTableSize := AHashTableSize; + FHashFunction := aHashFunc; +end; + +destructor TFPHashTable.Destroy; +begin + FHashTable.Free; + inherited Destroy; +end; + +function TFPHashTable.GetDensity: Longword; +begin + Result := FHashTableSize - VoidSlots +end; + +function TFPHashTable.GetNumberOfCollisions: Int64; +begin + Result := FCount -(FHashTableSize - VoidSlots) +end; + +procedure TFPHashTable.SetData(const index: string; const AValue: Pointer); +begin + FindOrCreateNew(index).Data := AValue; +end; + +procedure TFPHashTable.SetHashTableSize(const Value: Longword); +var + i: Longword; + newSize: Longword; +begin + if Value <> FHashTableSize then + begin + i := 0; + while (PRIMELIST[i] < Value) and (i < 27) do + inc(i); + newSize := PRIMELIST[i]; + if Count = 0 then + begin + FHashTableSize := newSize; + InitializeHashTable; + end + else + ChangeTableSize(newSize); + end; +end; + +procedure TFPHashTable.InitializeHashTable; +var + i: LongWord; +begin + for i := 0 to FHashTableSize-1 do + FHashTable.Add(nil); + FCount := 0; +end; + +procedure TFPHashTable.ChangeTableSize(const ANewSize: Longword); +var + SavedTable: TFPObjectList; + SavedTableSize: Longword; + i, j: Longword; + temp: THTNode; +begin + SavedTable := FHashTable; + SavedTableSize := FHashTableSize; + FHashTableSize := ANewSize; + FHashTable := TFPObjectList.Create(True); + InitializeHashTable; + for i := 0 to SavedTableSize-1 do + begin + if Assigned(SavedTable[i]) then + for j := 0 to TFPObjectList(SavedTable[i]).Count -1 do + begin + temp := THTNode(TFPObjectList(SavedTable[i])[j]); + Add(temp.Key, temp.Data); + end; + end; + SavedTable.Free; +end; + +procedure TFPHashTable.SetHashFunction(AHashFunction: THashFunction); +begin + if IsEmpty then + FHashFunction := AHashFunction + else + raise Exception.Create(NotEmptyMsg); +end; + +function TFPHashTable.Find(const aKey: string): THTNode; +var + hashCode: Longword; + chn: TFPObjectList; + i: Longword; +begin + hashCode := FHashFunction(aKey, FHashTableSize); + chn := Chain(hashCode); + if Assigned(chn) then + begin + for i := 0 to chn.Count - 1 do + if THTNode(chn[i]).HasKey(aKey) then + begin + result := THTNode(chn[i]); + exit; + end; + end; + Result := nil; +end; + +function TFPHashTable.GetData(const Index: string): Pointer; +var + node: THTNode; +begin + node := Find(Index); + if Assigned(node) then + Result := node.Data + else + Result := nil; +end; + +function TFPHashTable.FindOrCreateNew(const aKey: string): THTNode; +var + hashCode: Longword; + chn: TFPObjectList; + i: Longword; +begin + hashCode := FHashFunction(aKey, FHashTableSize); + chn := Chain(hashCode); + if Assigned(chn) then + begin + for i := 0 to chn.Count - 1 do + if THTNode(chn[i]).HasKey(aKey) then + begin + Result := THTNode(chn[i]); + exit; + end + end + else + begin + FHashTable[hashcode] := TFPObjectList.Create(true); + chn := Chain(hashcode); + end; + inc(FCount); + Result := THTNode.CreateWith(aKey); + chn.Add(Result); +end; + +function TFPHashTable.ChainLength(const ChainIndex: Longword): Longword; +begin + if Assigned(Chain(ChainIndex)) then + Result := Chain(ChainIndex).Count + else + Result := 0; +end; + +procedure TFPHashTable.Clear; +var + i: Longword; +begin + for i := 0 to FHashTableSize - 1 do + begin + if Assigned(Chain(i)) then + Chain(i).Clear; + end; + FCount := 0; +end; + +function TFPHashTable.ForEachCall(aMethod: TIteratorMethod): THTNode; +var + i, j: Longword; + continue: boolean; +begin + Result := nil; + continue := true; + for i := 0 to FHashTableSize-1 do + begin + if assigned(Chain(i)) then + begin + for j := 0 to Chain(i).Count-1 do + begin + aMethod(THTNode(Chain(i)[j]).Data, THTNode(Chain(i)[j]).Key, continue); + if not continue then + begin + Result := THTNode(Chain(i)[j]); + Exit; + end; + end; + end; + end; +end; + +procedure TFPHashTable.Add(const aKey: string; aItem: pointer); +var + hashCode: Longword; + chn: TFPObjectList; + i: Longword; + NewNode: THtNode; +begin + hashCode := FHashFunction(aKey, FHashTableSize); + chn := Chain(hashCode); + if Assigned(chn) then + begin + for i := 0 to chn.Count - 1 do + if THTNode(chn[i]).HasKey(aKey) then + Raise EDuplicate.CreateFmt(DuplicateMsg, [aKey]); + end + else + begin + FHashTable[hashcode] := TFPObjectList.Create(true); + chn := Chain(hashcode); + end; + inc(FCount); + NewNode := THTNode.CreateWith(aKey); + NewNode.Data := aItem; + chn.Add(NewNode); +end; + +procedure TFPHashTable.Delete(const aKey: string); +var + hashCode: Longword; + chn: TFPObjectList; + i: Longword; +begin + hashCode := FHashFunction(aKey, FHashTableSize); + chn := Chain(hashCode); + if Assigned(chn) then + begin + for i := 0 to chn.Count - 1 do + if THTNode(chn[i]).HasKey(aKey) then + begin + chn.Delete(i); + dec(FCount); + exit; + end; + end; + raise EKeyNotFound.CreateFmt(KeyNotFoundMsg, ['Delete', aKey]); +end; + +function TFPHashTable.IsEmpty: boolean; +begin + Result := (FCount = 0); +end; + +function TFPHashTable.Chain(const index: Longword): TFPObjectList; +begin + Result := TFPObjectList(FHashTable[index]); +end; + +function TFPHashTable.GetVoidSlots: Longword; +var + i: Longword; + num: Longword; +begin + num := 0; + for i:= 0 to FHashTableSize-1 do + if Not Assigned(Chain(i)) then + inc(num); + result := num; +end; + +function TFPHashTable.GetLoadFactor: double; +begin + Result := Count / FHashTableSize; +end; + +function TFPHashTable.GetAVGChainLen: double; +begin + result := Count / (FHashTableSize - VoidSlots); +end; + +function TFPHashTable.GetMaxChainLength: Longword; +var + i: Longword; +begin + Result := 0; + for i := 0 to FHashTableSize-1 do + if ChainLength(i) > Result then + Result := ChainLength(i); +end; + end.