diff options
Diffstat (limited to 'src/lib/collections/CollHash.pas')
| -rw-r--r-- | src/lib/collections/CollHash.pas | 1497 |
1 files changed, 0 insertions, 1497 deletions
diff --git a/src/lib/collections/CollHash.pas b/src/lib/collections/CollHash.pas deleted file mode 100644 index 796fc740..00000000 --- a/src/lib/collections/CollHash.pas +++ /dev/null @@ -1,1497 +0,0 @@ -unit CollHash; - -(***************************************************************************** - * Copyright 2003 by Matthew Greet - * This library is free software; you can redistribute it and/or modify it - * under the terms of the GNU Lesser General Public License as published by the - * Free Software Foundation; either version 2.1 of the License, or (at your - * option) any later version. - * - * This library 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. See the GNU Lesser General Public License for more - * details. (http://opensource.org/licenses/lgpl-license.php) - * - * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. - * - * $Version: v1.0.3 $ - * $Revision: 1.1.1.2 $ - * $Log: D:\QVCS Repositories\Delphi Collections\CollHash.qbt $ - * - * Collection implementations based on hash tables. - * - * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:04:30 - * Capacity property. - * - * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16 - * v1.0 branch. - * - * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:40:16 - * Added integer map and string map versions. - * THashSet uses its own implementation, not THashMap. - * DefaulMaxLoadFactor changed. - * - * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 - * Initial revision. - * - * FPC compatibility fixes by: UltraStar Deluxe Team - * - * $Endlog$ - *****************************************************************************) - -{$IFDEF FPC} - {$MODE Delphi}{$H+} -{$ENDIF} - -interface - -uses - Classes, Math, - Collections; - -const - DefaultTableSize = 100; - MaxLoadFactorMin = 0.01; // Minimum allowed value for MaxLoadFactor property. - DefaultMaxLoadFactor = 5.0; - -type - THashMap = class(TAbstractMap) - private - FArray: TListArray; - FCapacity: Integer; - FMaxLoadFactor: Double; - FSize: Integer; - FTableSize: Integer; - protected - function GetAssociationIterator: IMapIterator; override; - procedure SetMaxLoadFactor(Value: Double); virtual; - procedure SetTableSize(Value: Integer); virtual; - procedure ChangeCapacity(Value: TListArray); virtual; - procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; - function GetHash(const Key: ICollectable): Integer; virtual; - function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override; - procedure Rehash; - procedure TrueClear; override; - function TrueGet(Position: TCollectionPosition): IAssociation; override; - function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override; - function TrueRemove2(Position: TCollectionPosition): IAssociation; override; - public - constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override; - destructor Destroy; override; - class function GetAlwaysNaturalKeys: Boolean; override; - function GetCapacity: Integer; override; - procedure SetCapacity(Value: Integer); override; - function GetNaturalKeyIID: TGUID; override; - function GetSize: Integer; override; - property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; - property TableSize: Integer read FTableSize write SetTableSize; - end; - - THashSet = class(TAbstractSet) - private - FArray: TListArray; - FCapacity: Integer; - FMaxLoadFactor: Double; - FSize: Integer; - FTableSize: Integer; - protected - procedure SetMaxLoadFactor(Value: Double); virtual; - procedure SetTableSize(Value: Integer); virtual; - procedure ChangeCapacity(Value: TListArray); virtual; - procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; - function GetHash(const Item: ICollectable): Integer; virtual; - function GetPosition(const Item: ICollectable): TCollectionPosition; override; - procedure Rehash; - procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override; - procedure TrueClear; override; - function TrueGet(Position: TCollectionPosition): ICollectable; override; - procedure TrueRemove2(Position: TCollectionPosition); override; - public - constructor Create(NaturalItemsOnly: Boolean); override; - destructor Destroy; override; - class function GetAlwaysNaturalItems: Boolean; override; - function GetCapacity: Integer; override; - procedure SetCapacity(Value: Integer); override; - function GetIterator: IIterator; override; - function GetNaturalItemIID: TGUID; override; - function GetSize: Integer; override; - property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; - property TableSize: Integer read FTableSize write SetTableSize; - end; - - THashIntegerMap = class(TAbstractIntegerMap) - private - FArray: TListArray; - FCapacity: Integer; - FMaxLoadFactor: Double; - FSize: Integer; - FTableSize: Integer; - protected - function GetAssociationIterator: IIntegerMapIterator; override; - procedure SetMaxLoadFactor(Value: Double); virtual; - procedure SetTableSize(Value: Integer); virtual; - procedure ChangeCapacity(Value: TListArray); virtual; - procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; - function GetHash(const Key: Integer): Integer; virtual; - function GetKeyPosition(const Key: Integer): TCollectionPosition; override; - procedure Rehash; - procedure TrueClear; override; - function TrueGet(Position: TCollectionPosition): IIntegerAssociation; override; - function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; override; - function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; override; - public - constructor Create; override; - constructor Create(NaturalItemsOnly: Boolean); override; - constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual; - destructor Destroy; override; - function GetCapacity: Integer; override; - procedure SetCapacity(Value: Integer); override; - function GetSize: Integer; override; - property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; - property TableSize: Integer read FTableSize write SetTableSize; - end; - - THashStringMap = class(TAbstractStringMap) - private - FArray: TListArray; - FCapacity: Integer; - FMaxLoadFactor: Double; - FSize: Integer; - FTableSize: Integer; - protected - function GetAssociationIterator: IStringMapIterator; override; - procedure SetMaxLoadFactor(Value: Double); virtual; - procedure SetTableSize(Value: Integer); virtual; - procedure ChangeCapacity(Value: TListArray); virtual; - procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; - function GetHash(const Key: String): Integer; virtual; - function GetKeyPosition(const Key: String): TCollectionPosition; override; - procedure Rehash; - procedure TrueClear; override; - function TrueGet(Position: TCollectionPosition): IStringAssociation; override; - function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; override; - function TrueRemove2(Position: TCollectionPosition): IStringAssociation; override; - public - constructor Create; override; - constructor Create(NaturalItemsOnly: Boolean); override; - constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual; - destructor Destroy; override; - function GetCapacity: Integer; override; - procedure SetCapacity(Value: Integer); override; - function GetSize: Integer; override; - property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; - property TableSize: Integer read FTableSize write SetTableSize; - end; - -implementation - -const - (* (sqrt(5) - 1)/2 - See Introduction to Algorithms in Pascal, 1995, by Thomas W. Parsons, - published by John Wiley & Sons, Inc, ISBN 0-471-11600-9 - *) - HashFactor = 0.618033988749894848204586834365638; - -type - THashIterator = class(TAbstractIterator) - private - FHashSet: THashSet; - FHash: Integer; - FChainIndex: Integer; - protected - constructor Create(HashSet: THashSet); - function TrueFirst: ICollectable; override; - function TrueNext: ICollectable; override; - procedure TrueRemove; override; - end; - - THashAssociationIterator = class(TAbstractAssociationIterator) - private - FHashMap: THashMap; - FHash: Integer; - FChainIndex: Integer; - protected - constructor Create(HashMap: THashMap); - function TrueFirst: IAssociation; override; - function TrueNext: IAssociation; override; - procedure TrueRemove; override; - end; - - THashIntegerIterator = class(TAbstractIntegerAssociationIterator) - private - FHashIntegerMap: THashIntegerMap; - FHash: Integer; - FChainIndex: Integer; - protected - constructor Create(HashIntegerMap: THashIntegerMap); - function TrueFirst: IIntegerAssociation; override; - function TrueNext: IIntegerAssociation; override; - procedure TrueRemove; override; - end; - - THashStringIterator = class(TAbstractStringAssociationIterator) - private - FHashStringMap: THashStringMap; - FHash: Integer; - FChainIndex: Integer; - protected - constructor Create(HashStringMap: THashStringMap); - function TrueFirst: IStringAssociation; override; - function TrueNext: IStringAssociation; override; - procedure TrueRemove; override; - end; - - THashPosition = class(TCollectionPosition) - private - FChain: TList; - FIndex: Integer; - public - constructor Create(Found: Boolean; Chain: TList; Index: Integer); - property Chain: TList read FChain; - property Index: Integer read FIndex; - end; - -{ THashMap } -constructor THashMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); -var - I: Integer; -begin - // Force use of natural keys - inherited Create(NaturalItemsOnly, true); - FTableSize := DefaultTableSize; - FMaxLoadFactor := DefaultMaxLoadFactor; - SetLength(FArray, FTableSize); - for I := Low(FArray) to High(FArray) do - FArray[I] := TList.Create; - FCapacity := 0; - FSize := 0; - ChangeCapacity(FArray); -end; - -destructor THashMap.Destroy; -var - I: Integer; -begin - for I := Low(FArray) to High(FArray) do - FArray[I].Free; - FArray := nil; - inherited Destroy; -end; - -class function THashMap.GetAlwaysNaturalKeys: Boolean; -begin - Result := true; -end; - -function THashMap.GetNaturalKeyIID: TGUID; -begin - Result := HashableIID; -end; - -function THashMap.GetAssociationIterator: IMapIterator; -begin - Result := THashAssociationIterator.Create(Self); -end; - -procedure THashMap.SetTableSize(Value: Integer); -begin - if (FTableSize <> Value) and (Value >= 1) then - begin - FTableSize := Value; - Rehash; - end; -end; - -procedure THashMap.SetMaxLoadFactor(Value: Double); -begin - if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then - begin - FMaxLoadFactor := Value; - CheckLoadFactor(false); - end; -end; - -procedure THashMap.ChangeCapacity(Value: TListArray); -var - Chain: TList; - I, Total, ChainCapacity: Integer; -begin - if FCapacity mod FTableSize = 0 then - ChainCapacity := Trunc(FCapacity / FTableSize) - else - ChainCapacity := Trunc(FCapacity / FTableSize) + 1; - Total := 0; - for I := Low(Value) to High(Value) do - begin - Chain := Value[I]; - Chain.Capacity := ChainCapacity; - Total := Total + Chain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean); -var - LoadFactor: Double; -begin - LoadFactor := Capacity / TableSize; - if LoadFactor > MaxLoadFactor then - TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) - else if AlwaysChangeCapacity then - ChangeCapacity(FArray); -end; - -function THashMap.GetHash(const Key: ICollectable): Integer; -var - Hashable: IHashable; - HashCode: Cardinal; -begin - Key.QueryInterface(IHashable, Hashable); - HashCode := Hashable.HashCode; - Result := Trunc(Frac(HashCode * HashFactor) * TableSize); -end; - -function THashMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition; -var - Chain: TList; - I: Integer; - Success: Boolean; -begin - Chain := FArray[GetHash(Key)]; - Success := false; - for I := 0 to Chain.Count - 1 do - begin - Success := KeyComparator.Equals(Key, IAssociation(Chain[I]).GetKey); - if Success then - Break; - end; - Result := THashPosition.Create(Success, Chain, I); -end; - -procedure THashMap.Rehash; -var - NewArray: TListArray; - OldChain, NewChain: TList; - Association: IAssociation; - Total: Integer; - I, J: Integer; - Hash: Integer; -begin - // Create new chains - SetLength(NewArray, TableSize); - for I := Low(NewArray) to High(NewArray) do - begin - NewChain := TList.Create; - NewArray[I] := NewChain; - end; - ChangeCapacity(NewArray); - - // Transfer from old chains to new and drop old - for I := Low(FArray) to High(FArray) do - begin - OldChain := FArray[I]; - for J := 0 to OldChain.Count - 1 do - begin - Association := IAssociation(OldChain[J]); - Hash := GetHash(Association.GetKey); - NewArray[Hash].Add(Pointer(Association)); - end; - OldChain.Free; - end; - FArray := NewArray; - - // Find actual, new capacity - Total := 0; - for I := Low(FArray) to High(FArray) do - begin - NewChain := FArray[I]; - Total := Total + NewChain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashMap.TrueClear; -var - Association: IAssociation; - Chain: TList; - I, J: Integer; -begin - for I := Low(FArray) to High(FArray) do - begin - Chain := FArray[I]; - for J := 0 to Chain.Count - 1 do - begin - Association := IAssociation(Chain[J]); - Chain[J] := nil; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; - end; - Chain.Clear; - end; - FSize := 0; -end; - -function THashMap.TrueGet(Position: TCollectionPosition): IAssociation; -var - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Result := IAssociation(HashPosition.Chain.Items[HashPosition.Index]); -end; - -function THashMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; -var - HashPosition: THashPosition; - OldAssociation: IAssociation; -begin - HashPosition := THashPosition(Position); - if HashPosition.Found then - begin - OldAssociation := IAssociation(HashPosition.Chain.Items[HashPosition.Index]); - HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association); - Result := OldAssociation; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._AddRef; - OldAssociation._Release; - end - else - begin - HashPosition.Chain.Add(Pointer(Association)); - Inc(FSize); - Result := nil; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._AddRef; - end; -end; - -function THashMap.TrueRemove2(Position: TCollectionPosition): IAssociation; -var - Association: IAssociation; - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Association := IAssociation(TrueGet(Position)); - HashPosition.Chain.Delete(HashPosition.Index); - Dec(FSize); - Result := Association; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; -end; - -function THashMap.GetCapacity; -begin - Result := FCapacity; -end; - -procedure THashMap.SetCapacity(Value: Integer); -begin - FCapacity := Value; - CheckLoadFactor(true); -end; - -function THashMap.GetSize: Integer; -begin - Result := FSize; -end; - -{ THashSet } -constructor THashSet.Create(NaturalItemsOnly: Boolean); -var - I: Integer; -begin - // Force use of natural items - inherited Create(true); - FTableSize := DefaultTableSize; - FMaxLoadFactor := DefaultMaxLoadFactor; - SetLength(FArray, FTableSize); - for I := Low(FArray) to High(FArray) do - FArray[I] := TList.Create; - FSize := 0; -end; - -destructor THashSet.Destroy; -var - I: Integer; -begin - for I := Low(FArray) to High(FArray) do - FArray[I].Free; - FArray := nil; - inherited Destroy; -end; - -procedure THashSet.SetTableSize(Value: Integer); -begin - if (FTableSize <> Value) and (Value >= 1) then - begin - FTableSize := Value; - Rehash; - end; -end; - -procedure THashSet.SetMaxLoadFactor(Value: Double); -begin - if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then - begin - FMaxLoadFactor := Value; - CheckLoadFactor(false); - end; -end; - -procedure THashSet.ChangeCapacity(Value: TListArray); -var - Chain: TList; - I, Total, ChainCapacity: Integer; -begin - if FCapacity mod FTableSize = 0 then - ChainCapacity := Trunc(FCapacity / FTableSize) - else - ChainCapacity := Trunc(FCapacity / FTableSize) + 1; - Total := 0; - for I := Low(Value) to High(Value) do - begin - Chain := Value[I]; - Chain.Capacity := ChainCapacity; - Total := Total + Chain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashSet.CheckLoadFactor(AlwaysChangeCapacity: Boolean); -var - LoadFactor: Double; -begin - LoadFactor := Capacity / TableSize; - if LoadFactor > MaxLoadFactor then - TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) - else if AlwaysChangeCapacity then - ChangeCapacity(FArray); -end; - -function THashSet.GetHash(const Item: ICollectable): Integer; -var - Hashable: IHashable; - HashCode: Cardinal; -begin - Item.QueryInterface(IHashable, Hashable); - HashCode := Hashable.HashCode; - Result := Trunc(Frac(HashCode * HashFactor) * TableSize); -end; - -function THashSet.GetPosition(const Item: ICollectable): TCollectionPosition; -var - Chain: TList; - I: Integer; - Success: Boolean; -begin - Chain := FArray[GetHash(Item)]; - Success := false; - for I := 0 to Chain.Count - 1 do - begin - Success := Comparator.Equals(Item, ICollectable(Chain[I])); - if Success then - Break; - end; - Result := THashPosition.Create(Success, Chain, I); -end; - -procedure THashSet.Rehash; -var - NewArray: TListArray; - OldChain, NewChain: TList; - Item: ICollectable; - Total: Integer; - I, J: Integer; - Hash: Integer; -begin - // Create new chains - SetLength(NewArray, TableSize); - for I := Low(NewArray) to High(NewArray) do - begin - NewChain := TList.Create; - NewArray[I] := NewChain; - end; - ChangeCapacity(NewArray); - - // Transfer from old chains to new and drop old - for I := Low(FArray) to High(FArray) do - begin - OldChain := FArray[I]; - for J := 0 to OldChain.Count - 1 do - begin - Item := ICollectable(OldChain[J]); - Hash := GetHash(Item); - NewArray[Hash].Add(Pointer(Item)); - end; - OldChain.Free; - end; - FArray := NewArray; - - // Find actual, new capacity - Total := 0; - for I := Low(FArray) to High(FArray) do - begin - NewChain := FArray[I]; - Total := Total + NewChain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); -var - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - HashPosition.Chain.Add(Pointer(Item)); - Inc(FSize); - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Item._AddRef; -end; - -procedure THashSet.TrueClear; -var - Item: ICollectable; - Chain: TList; - I, J: Integer; -begin - for I := Low(FArray) to High(FArray) do - begin - Chain := FArray[I]; - for J := 0 to Chain.Count - 1 do - begin - Item := ICollectable(Chain[J]); - Chain[J] := nil; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Item._Release; - end; - Chain.Clear; - end; - FSize := 0; -end; - -function THashSet.TrueGet(Position: TCollectionPosition): ICollectable; -var - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Result := ICollectable(HashPosition.Chain.Items[HashPosition.Index]); -end; - -procedure THashSet.TrueRemove2(Position: TCollectionPosition); -var - Item: ICollectable; - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Item := TrueGet(Position); - HashPosition.Chain.Delete(HashPosition.Index); - Dec(FSize); - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Item._Release; -end; - -class function THashSet.GetAlwaysNaturalItems: Boolean; -begin - Result := true; -end; - -function THashSet.GetIterator: IIterator; -begin - Result := THashIterator.Create(Self); -end; - -function THashSet.GetNaturalItemIID: TGUID; -begin - Result := HashableIID; -end; - -function THashSet.GetCapacity; -begin - Result := FCapacity; -end; - -procedure THashSet.SetCapacity(Value: Integer); -begin - FCapacity := Value; - CheckLoadFactor(true); -end; - -function THashSet.GetSize: Integer; -begin - Result := FSize; -end; - -{ THashIntegerMap } -constructor THashIntegerMap.Create; -begin - Create(false, DefaultTableSize, DefaultMaxLoadFactor); -end; - -constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean); -begin - Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor); -end; - -constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); -var - I: Integer; -begin - inherited Create(NaturalItemsOnly); - SetLength(FArray, TableSize); - for I := Low(FArray) to High(FArray) do - FArray[I] := TList.Create; - FTableSize := TableSize; - FMaxLoadFactor := MaxLoadFactor; - FSize := 0; -end; - -destructor THashIntegerMap.Destroy; -var - I: Integer; -begin - for I := Low(FArray) to High(FArray) do - FArray[I].Free; - FArray := nil; - inherited Destroy; -end; - -function THashIntegerMap.GetAssociationIterator: IIntegerMapIterator; -begin - Result := THashIntegerIterator.Create(Self); -end; - -procedure THashIntegerMap.SetTableSize(Value: Integer); -begin - if (FTableSize <> Value) and (Value >= 1) then - begin - FTableSize := Value; - Rehash; - end; -end; - -procedure THashIntegerMap.SetMaxLoadFactor(Value: Double); -begin - if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then - begin - FMaxLoadFactor := Value; - CheckLoadFactor(false); - end; -end; - -procedure THashIntegerMap.ChangeCapacity; -var - Chain: TList; - I, Total, ChainCapacity: Integer; -begin - if FCapacity mod FTableSize = 0 then - ChainCapacity := Trunc(FCapacity / FTableSize) - else - ChainCapacity := Trunc(FCapacity / FTableSize) + 1; - Total := 0; - for I := Low(Value) to High(Value) do - begin - Chain := Value[I]; - Chain.Capacity := ChainCapacity; - Total := Total + Chain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashIntegerMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean); -var - LoadFactor: Double; -begin - LoadFactor := Capacity / TableSize; - if LoadFactor > MaxLoadFactor then - TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) - else if AlwaysChangeCapacity then - ChangeCapacity(FArray); -end; - -function THashIntegerMap.GetHash(const Key: Integer): Integer; -begin - Result := Trunc(Frac(Cardinal(Key) * HashFactor) * TableSize); -end; - -function THashIntegerMap.GetKeyPosition(const Key: Integer): TCollectionPosition; -var - Chain: TList; - I: Integer; - Success: Boolean; -begin - Chain := FArray[GetHash(Key)]; - Success := false; - for I := 0 to Chain.Count - 1 do - begin - Success := (Key = IIntegerAssociation(Chain[I]).GetKey); - if Success then - Break; - end; - Result := THashPosition.Create(Success, Chain, I); -end; - -procedure THashIntegerMap.Rehash; -var - NewArray: TListArray; - OldChain, NewChain: TList; - Association: IIntegerAssociation; - Total: Integer; - I, J: Integer; - Hash: Integer; -begin - // Create new chains - SetLength(NewArray, TableSize); - for I := Low(NewArray) to High(NewArray) do - begin - NewChain := TList.Create; - NewArray[I] := NewChain; - end; - ChangeCapacity(NewArray); - - // Transfer from old chains to new and drop old - for I := Low(FArray) to High(FArray) do - begin - OldChain := FArray[I]; - for J := 0 to OldChain.Count - 1 do - begin - Association := IIntegerAssociation(OldChain[J]); - Hash := GetHash(Association.GetKey); - NewArray[Hash].Add(Pointer(Association)); - end; - OldChain.Free; - end; - FArray := NewArray; - - // Find actual, new capacity - Total := 0; - for I := Low(FArray) to High(FArray) do - begin - NewChain := FArray[I]; - Total := Total + NewChain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashIntegerMap.TrueClear; -var - Association: IIntegerAssociation; - Chain: TList; - I, J: Integer; -begin - for I := Low(FArray) to High(FArray) do - begin - Chain := FArray[I]; - for J := 0 to Chain.Count - 1 do - begin - Association := IIntegerAssociation(Chain[J]); - Chain[J] := nil; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; - end; - Chain.Clear; - end; - FSize := 0; -end; - -function THashIntegerMap.TrueGet(Position: TCollectionPosition): IIntegerAssociation; -var - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Result := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]); -end; - -function THashIntegerMap.TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; -var - HashPosition: THashPosition; - OldAssociation: IIntegerAssociation; -begin - HashPosition := THashPosition(Position); - if HashPosition.Found then - begin - OldAssociation := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]); - HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association); - Result := OldAssociation; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._AddRef; - OldAssociation._Release; - end - else - begin - HashPosition.Chain.Add(Pointer(Association)); - Inc(FSize); - Result := nil; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._AddRef; - end; -end; - -function THashIntegerMap.TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; -var - Association: IIntegerAssociation; - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Association := IIntegerAssociation(TrueGet(Position)); - HashPosition.Chain.Delete(HashPosition.Index); - Dec(FSize); - Result := Association; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; -end; - -function THashIntegerMap.GetCapacity; -begin - Result := FCapacity; -end; - -procedure THashIntegerMap.SetCapacity(Value: Integer); -begin - FCapacity := Value; - CheckLoadFactor(true); -end; - -function THashIntegerMap.GetSize: Integer; -begin - Result := FSize; -end; - -{ THashStringMap } -constructor THashStringMap.Create; -begin - Create(false, DefaultTableSize, DefaultMaxLoadFactor); -end; - -constructor THashStringMap.Create(NaturalItemsOnly: Boolean); -begin - Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor); -end; - -constructor THashStringMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); -var - I: Integer; -begin - inherited Create(NaturalItemsOnly); - SetLength(FArray, TableSize); - for I := Low(FArray) to High(FArray) do - FArray[I] := TList.Create; - FTableSize := TableSize; - FMaxLoadFactor := MaxLoadFactor; - FSize := 0; -end; - -destructor THashStringMap.Destroy; -var - I: Integer; -begin - for I := Low(FArray) to High(FArray) do - FArray[I].Free; - FArray := nil; - inherited Destroy; -end; - -function THashStringMap.GetAssociationIterator: IStringMapIterator; -begin - Result := THashStringIterator.Create(Self); -end; - -procedure THashStringMap.SetTableSize(Value: Integer); -begin - if (FTableSize <> Value) and (Value >= 1) then - begin - FTableSize := Value; - Rehash; - end; -end; - -procedure THashStringMap.SetMaxLoadFactor(Value: Double); -begin - if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then - begin - FMaxLoadFactor := Value; - CheckLoadFactor(false); - end; -end; - -procedure THashStringMap.ChangeCapacity; -var - Chain: TList; - I, Total, ChainCapacity: Integer; -begin - if FCapacity mod FTableSize = 0 then - ChainCapacity := Trunc(FCapacity / FTableSize) - else - ChainCapacity := Trunc(FCapacity / FTableSize) + 1; - Total := 0; - for I := Low(Value) to High(Value) do - begin - Chain := Value[I]; - Chain.Capacity := ChainCapacity; - Total := Total + Chain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashStringMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean); -var - LoadFactor: Double; -begin - LoadFactor := Capacity / TableSize; - if LoadFactor > MaxLoadFactor then - TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) - else if AlwaysChangeCapacity then - ChangeCapacity(FArray); -end; - -function THashStringMap.GetHash(const Key: String): Integer; -var - HashCode: Cardinal; - I: Integer; -begin - HashCode := 0; - for I := 1 to Length(Key) do - HashCode := (HashCode shl 1) xor Ord(Key[I]); - Result := Trunc(Frac(HashCode * HashFactor) * TableSize); -end; - -function THashStringMap.GetKeyPosition(const Key: String): TCollectionPosition; -var - Chain: TList; - I: Integer; - Success: Boolean; -begin - Chain := FArray[GetHash(Key)]; - Success := false; - for I := 0 to Chain.Count - 1 do - begin - Success := (Key = IStringAssociation(Chain[I]).GetKey); - if Success then - Break; - end; - Result := THashPosition.Create(Success, Chain, I); -end; - -procedure THashStringMap.Rehash; -var - NewArray: TListArray; - OldChain, NewChain: TList; - Association: IStringAssociation; - Total: Integer; - I, J: Integer; - Hash: Integer; -begin - // Create new chains - SetLength(NewArray, TableSize); - for I := Low(NewArray) to High(NewArray) do - begin - NewChain := TList.Create; - NewArray[I] := NewChain; - end; - ChangeCapacity(NewArray); - - // Transfer from old chains to new and drop old - for I := Low(FArray) to High(FArray) do - begin - OldChain := FArray[I]; - for J := 0 to OldChain.Count - 1 do - begin - Association := IStringAssociation(OldChain[J]); - Hash := GetHash(Association.GetKey); - NewArray[Hash].Add(Pointer(Association)); - end; - OldChain.Free; - end; - FArray := NewArray; - - // Find actual, new capacity - Total := 0; - for I := Low(FArray) to High(FArray) do - begin - NewChain := FArray[I]; - Total := Total + NewChain.Capacity; - end; - FCapacity := Total; -end; - -procedure THashStringMap.TrueClear; -var - Association: IStringAssociation; - Chain: TList; - I, J: Integer; -begin - for I := Low(FArray) to High(FArray) do - begin - Chain := FArray[I]; - for J := 0 to Chain.Count - 1 do - begin - Association := IStringAssociation(Chain[J]); - Chain[J] := nil; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; - end; - Chain.Clear; - end; - FSize := 0; -end; - -function THashStringMap.TrueGet(Position: TCollectionPosition): IStringAssociation; -var - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Result := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]); -end; - -function THashStringMap.TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; -var - HashPosition: THashPosition; - OldAssociation: IStringAssociation; -begin - HashPosition := THashPosition(Position); - if HashPosition.Found then - begin - OldAssociation := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]); - HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association); - Result := OldAssociation; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._AddRef; - OldAssociation._Release; - end - else - begin - HashPosition.Chain.Add(Pointer(Association)); - Inc(FSize); - Result := nil; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._AddRef; - end; -end; - -function THashStringMap.TrueRemove2(Position: TCollectionPosition): IStringAssociation; -var - Association: IStringAssociation; - HashPosition: THashPosition; -begin - HashPosition := THashPosition(Position); - Association := IStringAssociation(TrueGet(Position)); - HashPosition.Chain.Delete(HashPosition.Index); - Dec(FSize); - Result := Association; - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; -end; - -function THashStringMap.GetCapacity; -begin - Result := FCapacity; -end; - -procedure THashStringMap.SetCapacity(Value: Integer); -begin - FCapacity := Value; - CheckLoadFactor(true); -end; - -function THashStringMap.GetSize: Integer; -begin - Result := FSize; -end; - -{ THashPosition } -constructor THashPosition.Create(Found: Boolean; Chain: TList; Index: Integer); -begin - inherited Create(Found); - FChain := Chain; - FIndex := Index; -end; - -{ THashIterator } -constructor THashIterator.Create(HashSet: THashSet); -begin - inherited Create(true); - FHashSet := HashSet; - First; -end; - -function THashIterator.TrueFirst: ICollectable; -var - Chain: TList; - Success: Boolean; -begin - FHash := 0; - FChainIndex := 0; - Success := false; - while FHash < FHashSet.TableSize do - begin - Chain := FHashSet.FArray[FHash]; - Success := Chain.Count > 0; - if Success then - Break; - Inc(FHash); - end; - if Success then - Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -function THashIterator.TrueNext: ICollectable; -var - Chain: TList; - Success: Boolean; -begin - Success := false; - Chain := FHashSet.FArray[FHash]; - repeat - Inc(FChainIndex); - if FChainIndex >= Chain.Count then - begin - Inc(FHash); - FChainIndex := -1; - if FHash < FHashSet.TableSize then - Chain := FHashSet.FArray[FHash]; - end - else - Success := true; - until Success or (FHash >= FHashSet.TableSize); - if Success then - Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -procedure THashIterator.TrueRemove; -var - Item: ICollectable; -begin - Item := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]); - FHashSet.FArray[FHash].Delete(FChainIndex); - Dec(FChainIndex); - Dec(FHashSet.FSize); - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Item._Release; -end; - - -{ THashAssociationIterator } -constructor THashAssociationIterator.Create(HashMap: THashMap); -begin - inherited Create(true); - FHashMap := HashMap; - First; -end; - -function THashAssociationIterator.TrueFirst: IAssociation; -var - Chain: TList; - Success: Boolean; -begin - FHash := 0; - FChainIndex := 0; - Success := false; - while FHash < FHashMap.TableSize do - begin - Chain := FHashMap.FArray[FHash]; - Success := Chain.Count > 0; - if Success then - Break; - Inc(FHash); - end; - if Success then - Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -function THashAssociationIterator.TrueNext: IAssociation; -var - Chain: TList; - Success: Boolean; -begin - Success := false; - Chain := FHashMap.FArray[FHash]; - repeat - Inc(FChainIndex); - if FChainIndex >= Chain.Count then - begin - Inc(FHash); - FChainIndex := -1; - if FHash < FHashMap.TableSize then - Chain := FHashMap.FArray[FHash]; - end - else - Success := true; - until Success or (FHash >= FHashMap.TableSize); - if Success then - Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -procedure THashAssociationIterator.TrueRemove; -var - Association: IAssociation; -begin - Association := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]); - FHashMap.FArray[FHash].Delete(FChainIndex); - Dec(FChainIndex); - Dec(FHashMap.FSize); - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; -end; - - -{ THashIntegerIterator } -constructor THashIntegerIterator.Create(HashIntegerMap: THashIntegerMap); -begin - inherited Create(true); - FHashIntegerMap := HashIntegerMap; - First; -end; - -function THashIntegerIterator.TrueFirst: IIntegerAssociation; -var - Chain: TList; - Success: Boolean; -begin - FHash := 0; - FChainIndex := 0; - Success := false; - while FHash < FHashIntegerMap.TableSize do - begin - Chain := FHashIntegerMap.FArray[FHash]; - Success := Chain.Count > 0; - if Success then - Break; - Inc(FHash); - end; - if Success then - Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -function THashIntegerIterator.TrueNext: IIntegerAssociation; -var - Chain: TList; - Success: Boolean; -begin - Success := false; - Chain := FHashIntegerMap.FArray[FHash]; - repeat - Inc(FChainIndex); - if FChainIndex >= Chain.Count then - begin - Inc(FHash); - FChainIndex := -1; - if FHash < FHashIntegerMap.TableSize then - Chain := FHashIntegerMap.FArray[FHash]; - end - else - Success := true; - until Success or (FHash >= FHashIntegerMap.TableSize); - if Success then - Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -procedure THashIntegerIterator.TrueRemove; -var - Association: IIntegerAssociation; -begin - Association := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]); - FHashIntegerMap.FArray[FHash].Delete(FChainIndex); - Dec(FChainIndex); - Dec(FHashIntegerMap.FSize); - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; -end; - -{ THashStringIterator } -constructor THashStringIterator.Create(HashStringMap: THashStringMap); -begin - inherited Create(true); - FHashStringMap := HashStringMap; - First; -end; - -function THashStringIterator.TrueFirst: IStringAssociation; -var - Chain: TList; - Success: Boolean; -begin - FHash := 0; - FChainIndex := 0; - Success := false; - while FHash < FHashStringMap.TableSize do - begin - Chain := FHashStringMap.FArray[FHash]; - Success := Chain.Count > 0; - if Success then - Break; - Inc(FHash); - end; - if Success then - Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -function THashStringIterator.TrueNext: IStringAssociation; -var - Chain: TList; - Success: Boolean; -begin - Success := false; - Chain := FHashStringMap.FArray[FHash]; - repeat - Inc(FChainIndex); - if FChainIndex >= Chain.Count then - begin - Inc(FHash); - FChainIndex := -1; - if FHash < FHashStringMap.TableSize then - Chain := FHashStringMap.FArray[FHash]; - end - else - Success := true; - until Success or (FHash >= FHashStringMap.TableSize); - if Success then - Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]) - else - Result := nil; -end; - -procedure THashStringIterator.TrueRemove; -var - Association: IStringAssociation; -begin - Association := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]); - FHashStringMap.FArray[FHash].Delete(FChainIndex); - Dec(FChainIndex); - Dec(FHashStringMap.FSize); - // Storing interface reference as a pointer does not update reference - // count automatically, so this must be done manually - Association._Release; -end; - - -end. |