Use objects as keys in a TObjectDictionary

When I use TObjectDictionary, where TKey is an object, my application does not work correctly. I have two units that contain two classes. First block:

unit RubTerm; interface type TRubTerm = Class(TObject) private FRubricName: String; FTermName: String; public property RubricName: String read FRubricName; property TermName: String read FTermName; constructor Create(ARubricName, ATermName: String); end; implementation constructor TRubTerm.Create(ARubricName, ATermName: String); begin Self.FRubricName := ARubricName; Self.FTermName := ATermName; end; end; 

And the second block:

 unit ClassificationMatrix; interface uses System.Generics.Collections, System.Generics.Defaults, System.SysUtils, RubTerm; type TClassificationMatrix = class(TObject) private FTable: TObjectDictionary<TRubTerm, Integer>; public constructor Create; procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName, ATermName: String); function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer; end; implementation constructor TClassificationMatrix.Create; begin FTable := TObjectDictionary<TRubTerm, Integer>.Create; end; procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName, ATermName: String); var ARubTerm: TRubTerm; begin ARubTerm := TRubTerm.Create(ARubName, ATermName); FTable.Add(ARubTerm, ADocsCount); end; function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer; var ARubTerm: TRubTerm; begin ARubTerm := TRubTerm.Create(ARubName, ATermName); FTable.TryGetValue(ARubTerm, Result); end; end; 

But this piece of code is working abnormally:

 procedure TestTClassificationMatrix.TestGetCount; var DocsCountTest: Integer; begin FClassificationMatrix.AddCount(10, 'R', 'T'); DocsCountTest := FClassificationMatrix.GetCount('R', 'T'); end; // DocsCountTest = 0! Why not 10? Where is problem? 

Thanks!

+6
source share
2 answers

The dictionary depends on the key value. You save the link to the object in the key. If you create two objects that are configured the same way, they have different values ​​and, therefore, different keys.

 var ARubTerm1: TRubTerm; ARubTerm2: TRubTerm; begin ARubTerm1 := TRubTerm.Create('1', '1'); ARubTerm2 := TRubTerm.Create('1', '1'); // ARubTerm1 = ARubTerm2 is not possible here as ARubTerm1 points to a different address than ARubTerm2 end; 

Instead, you can use String as the first type parameter in TObjectDictonary, which is based on RubricName and TermName. After that, you will get the same value.

It should also be noted that the above code in XE2 creates two memory leaks. Each object created must be freed. Therefore, this section of code also contains a memory leak.

 function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer; var ARubTerm: TRubTerm; begin ARubTerm := TRubTerm.Create(ARubName, ATermName); FTable.TryGetValue(ARubTerm, Result); end; 

Given all this. If you want to use Object as a key, you can do it with Custom Equality Comparer. Here is your example modified to implement IEqualityComparer<T> and fix some memory leaks.

 unit ClassificationMatrix; interface uses Generics.Collections, Generics.Defaults, SysUtils, RubTerm; type TClassificationMatrix = class(TObject) private FTable: TObjectDictionary<TRubTerm, Integer>; public constructor Create; procedure AddCount(ADocsCount: Integer; ARubName, ATermName: String); function GetCount(ARubName, ATermName: String): Integer; end; implementation constructor TClassificationMatrix.Create; var Comparer : IEqualityComparer<RubTerm.TRubTerm>; begin Comparer := TRubTermComparer.Create; FTable := TObjectDictionary<TRubTerm, Integer>.Create([doOwnsKeys],TRubTermComparer.Create); end; procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName, ATermName: String); var ARubTerm: TRubTerm; begin ARubTerm := TRubTerm.Create(ARubName, ATermName); FTable.Add(ARubTerm, ADocsCount); end; function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer; var ARubTerm: TRubTerm; begin ARubTerm := TRubTerm.Create(ARubName, ATermName); try if Not FTable.TryGetValue(ARubTerm, Result) then result := 0; finally ARubTerm.Free; end; end; end. 

And the RubTerm.pas block

 unit RubTerm; interface uses Generics.Defaults; type TRubTerm = Class(TObject) private FRubricName: String; FTermName: String; public property RubricName: String read FRubricName; property TermName: String read FTermName; constructor Create(ARubricName, ATermName: String); function GetHashCode: Integer; override; end; TRubTermComparer = class(TInterfacedObject, IEqualityComparer<TRubTerm>) public function Equals(const Left, Right: TRubTerm): Boolean; function GetHashCode(const Value: TRubTerm): Integer; end; implementation constructor TRubTerm.Create(ARubricName, ATermName: String); begin Self.FRubricName := ARubricName; Self.FTermName := ATermName; end; { TRubTermComparer } function TRubTermComparer.Equals(const Left, Right: TRubTerm): Boolean; begin result := (Left.RubricName = Right.RubricName) and (Left.TermName = Right.TermName); end; function TRubTermComparer.GetHashCode(const Value: TRubTerm): Integer; begin result := Value.GetHashCode; end; //The Hashing code was taken from David Answer to make this a complete answer. {$IFOPT Q+} {$DEFINE OverflowChecksEnabled} {$Q-} {$ENDIF} function CombinedHash(const Values: array of Integer): Integer; var Value: Integer; begin Result := 17; for Value in Values do begin Result := Result*37 + Value; end; end; {$IFDEF OverflowChecksEnabled} {$Q+} {$ENDIF} function GetHashCodeString(const Value: string): Integer; begin Result := BobJenkinsHash(PChar(Value)^, SizeOf(Char) * Length(Value), 0); end; function TRubTerm.GetHashCode: Integer; begin Result := CombinedHash([GetHashCodeString(Value.RubricName), GetHashCodeString(Value.TermName)]); end; end. 
+3
source

The main problem here is that the default mapping for your type does not behave the way you want it. You want equality to mean equality of values, but comparison by default gives referential equality.

The fact that you are hoping for equal value is convincing evidence that you should use a value type, not a reference type. And this is the first change I would suggest.

 type TRubTerm = record RubricName: string; TermName: string; class function New(const RubricName, TermName: string): TRubTerm; static; class operator Equal(const A, B: TRubTerm): Boolean; class operator NotEqual(const A, B: TRubTerm): Boolean; end; class function TRubTerm.New(const RubricName, TermName: string): TRubTerm; begin Result.RubricName := RubricName; Result.TermName := TermName; end; class operator TRubTerm.Equal(const A, B: TRubTerm): Boolean; begin Result := (A.RubricName=B.RubricName) and (A.TermName=B.TermName); end; class operator TRubTerm.NotEqual(const A, B: TRubTerm): Boolean; begin Result := not (A=B); end; 

I added TRubTerm.New as a helper method to simplify the initialization of new record instances. And for convenience, you can also use equality and inequality to overload operators, as I said above.

Once you switch to value type, you will also change the dictionary to match. Use TDictionary<TRubTerm, Integer> instead of TObjectDictionary<TRubTerm, Integer> . Switching to a value type will also have the advantage of fixing all memory leaks in existing code. Your existing code creates objects, but does not destroy them.

This gives you part of the way home, but you still need to determine the comparative equality factor for your vocabulary. The default comparison tool for writing will be based on reference equality, because strings, although they behave like value types, are stored as references.

To make a suitable TRubTerm , you need to implement the following comparison functions, where T is replaced by TRubTerm :

 TEqualityComparison<T> = reference to function(const Left, Right: T): Boolean; THasher<T> = reference to function(const Value: T): Integer; 

I would use them as static methods of a recording class.

 type TRubTerm = record RubricName: string; TermName: string; class function New(const RubricName, TermName: string): TRubTerm; static; class function EqualityComparison(const Left, Right: TRubTerm): Boolean; static; class function Hasher(const Value: TRubTerm): Integer; static; class operator Equal(const A, B: TRubTerm): Boolean; class operator NotEqual(const A, B: TRubTerm): Boolean; end; 

The implementation of EqualityComparison quite simple:

 class function TRubTerm.EqualityComparison(const Left, Right: TRubTerm): Boolean; begin Result := Left=Right; end; 

But a hasher requires a little more thought. You need to hash each field separately and then combine the hashes. For reference:

The code is as follows:

 {$IFOPT Q+} {$DEFINE OverflowChecksEnabled} {$Q-} {$ENDIF} function CombinedHash(const Values: array of Integer): Integer; var Value: Integer; begin Result := 17; for Value in Values do begin Result := Result*37 + Value; end; end; {$IFDEF OverflowChecksEnabled} {$Q+} {$ENDIF} function GetHashCodeString(const Value: string): Integer; begin Result := BobJenkinsHash(PChar(Value)^, SizeOf(Char) * Length(Value), 0); end; class function TRubTerm.Hasher(const Value: TRubTerm): Integer; begin Result := CombinedHash([GetHashCodeString(Value.RubricName), GetHashCodeString(Value.TermName)]); end; 

Finally, when you instantiate the dictionary, you need to provide IEqualityComparison<TRubTerm> . Create your dictionary as follows:

 Dict := TDictionary<TRubTerm,Integer>.Create( TEqualityComparer<TRubTerm>.Construct( TRubTerm.EqualityComparison, TRubTerm.Hasher ) ); 
+7
source

Source: https://habr.com/ru/post/951077/


All Articles