2013-08-05 74 views
6

當我使用TObjectDictionary,其中TKey是對象時,我的應用程序工作不正確。 我有兩個單位,即包含兩個類。第一單元:使用對象作爲TObjectDictionary中的鍵

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; 

而第二單元:

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; 

但代碼工作非正常的這個片段:

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? 

謝謝!

+1

你必須添加一個相等比較器讓字典知道,你是什麼意思的平等。否則,密鑰索引建立在實例參考 –

回答

3

字典取決於一個關鍵值。您正在存儲對密鑰中的對象的引用。如果創建兩個設置完全相同的對象,則具有不同的值,因此具有不同的鍵。

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; 

相反,您可以使用字符串作爲基於RubricName和TermName的TObjectDictonary中的第一個類型參數。有了這個,你會得到相同的價值。

還應該注意的是,XE2中的上述代碼會產生兩個內存泄漏。每個創建的對象都必須被釋放。因此這部分代碼也在泄漏內存

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

考慮到所有這一切。如果你想使用一個對象作爲一個鍵,你可以使用自定義等式比較器來完成。這裏是你的例子改爲執行IEqualityComparer<T>,並修復一些內存泄漏。

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. 

而且RubTerm.pas單元

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's 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. 
+2

上。這在一般情況下是廣義的,但是在具體情況中嚴重錯誤。您不能連接兩個字符串並比較結果。如果你這樣做,那麼你有'一個',''='','一個'例如。你需要比較兩個字段。散列的方法相同。而且你不能通過使用散列來實現equals。不同的散列意味着不同的值。但是相同的散列並不意味着相同的值。有更多的值存在散列,所以這顯然是一個錯誤的假設。 –

+0

更新了我的Equals實現,但只保留哈希,因爲它在答案中覆蓋得更好。 –

+0

如果你不打算修復哈希碼(並且我沒有看到你不應該修復它的原因,並且可以隨意從我的答案中複製代碼,如果你願意的話),你至少應該在編輯中清楚說明它被打破。 –

7

的根本問題,這裏是你的類型的默認相等比較器的行爲不想要的方式運行。你想要的平等意味着值相等,但默認比較給出參考相等

事實上,你希望值相等是一個強烈的跡象表明,你應該使用值類型而不是引用類型。這是我建議的第一個改變。

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; 

我添加TRubTerm.New作爲輔助方法可以很容易地初始化記錄的新實例。爲了方便起見,您可能會發現如上所述,重載等式和不等式運算符會很有用。

一旦你切換到一個值類型,那麼你也會改變字典來匹配。使用TDictionary<TRubTerm, Integer>而不是TObjectDictionary<TRubTerm, Integer>。切換到一個值類型也將有利於修復現有代碼中的所有內存泄漏。您現有的代碼會創建對象,但不會破壞它們。

這會讓你回家的路上,但你仍然需要爲你的字典定義一個相等比較器。記錄的默認比較器將基於引用相等性,因爲字符串(儘管用作值類型)存儲爲引用。

爲了讓你需要實現以下比較函數,其中TTRubTerm更換合適的相等比較:

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

我會實現創紀錄的這些作爲靜態類的方法。

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; 

實施EqualityComparison是很容易的:

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

但散列器,需要多一點思考。您需要分別對每個字段進行散列,然後將散列組合起來。供參考:

的代碼看起來是這樣的:

{$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; 

最後,當你實例化你的字典,你需要提供一個IEqualityComparison<TRubTerm>。像這樣實例化你的字典:

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

一如既往的出色工作。但作爲一個旁觀,退後一秒,與其他一些語言相比,這看起來不是很多工作嗎?您是否想過簡化這一部分的基礎工作將與XE5和nextgen編譯器一起提供?值類型與引用類型,對象與Delphi的只是因爲我們沒有內存管理記錄與方法,TDictionary與TObjectDictionary,11個不同的比較類...它似乎只是語言膨脹不受控制地解決許多從未解決的缺陷。和「BobJenkinsHash」而不是「哈希」? :-( – alcalde

+1

@alcade我同意語法太笨拙和冗長。 –