那些遇到过的问题

在TObjectDictionary中使用对象作为键

And*_*rew 6 delphi delphi-xe2

当我使用TObjectDictionary时,TKey是对象,我的应用程序工作不正确.我有两个单元,它包含两个类.第一单元:

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;
Run Code Online (Sandbox Code Playgroud)

第二单元:

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;
Run Code Online (Sandbox Code Playgroud)

但是这段代码工作不正常:

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?
Run Code Online (Sandbox Code Playgroud)

谢谢!

Dav*_*nan 8

这里的根本问题是您的类型的默认相等比较器的行为不符合您的要求.您希望等式表示值相等,但默认比较提供引用相等性.

您希望值相等的事实强烈表明您应该使用值类型而不是引用类型.这是我建议的第一个变化.

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;
Run Code Online (Sandbox Code Playgroud)

我已经添加TRubTerm.New了一个辅助方法,可以很容易地初始化记录的新实例.为方便起见,您可能会发现重载相等和不等式运算符很有用,正如我上面所做的那样.

切换到值类型后,您还可以更改字典以匹配.用TDictionary<TRubTerm, Integer>而不是TObjectDictionary<TRubTerm, Integer>.切换到值类型还可以修复现有代码中的所有内存泄漏.您现有的代码创建对象但从不销毁它们.

这会让你回家,但你仍然需要为你的字典定义一个相等比较器.记录的默认比较器将基于引用相等性,因为尽管表现为值类型,但字符串仍存储为引用.

要创建一个合适的相等比较器,您需要实现以下比较函数,其中T替换为TRubTerm:

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

我将这些实现为记录的静态类方法.

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;
Run Code Online (Sandbox Code Playgroud)

实施EqualityComparison很容易:

class function TRubTerm.EqualityComparison(const Left, Right: TRubTerm): Boolean;
begin
  Result := Left=Right;
end;
Run Code Online (Sandbox Code Playgroud)

但是,哈希需要更多的思考.您需要单独散列每个字段,然后组合散列.以供参考:

代码如下所示:

{$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;
Run Code Online (Sandbox Code Playgroud)

最后,当您实例化字典时,需要提供一个IEqualityComparison<TRubTerm>.像这样实例化你的字典:

Dict := TDictionary<TRubTerm,Integer>.Create(
  TEqualityComparer<TRubTerm>.Construct(
    TRubTerm.EqualityComparison,
    TRubTerm.Hasher
  )
);
Run Code Online (Sandbox Code Playgroud)

Rob*_*ove 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;
Run Code Online (Sandbox Code Playgroud)

相反，您可以使用字符串作为基于 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;
Run Code Online (Sandbox Code Playgroud)

鉴于这一切。如果您想使用对象作为键，您可以使用自定义相等比较器来完成。这是您更改为实现的示例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.
Run Code Online (Sandbox Code Playgroud)

和 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.
Run Code Online (Sandbox Code Playgroud)

  • 这在总体上是合理的，但在具体细节上却是严重错误的。您无法连接两个字符串并比较结果。如果这样做，那么您就会得到 'a'、'' = ''、'a' 等。您需要比较这两个字段。哈希的方法相同。并且你不能通过使用哈希来实现 equals。不同的哈希意味着不同的值。但相等的哈希值并不意味着相等的值。有更多的值有哈希值，因此这显然是一个错误的假设。 (2认同)

归档时间：

查看次数：

3205 次

最近记录：

12 年，1 月 前
快速简单的哈希码组合 55
为TEqualityComparer.Construct编写hasher函数的规范方法是什么？ 5
更多相关链接
相关归档
如何调整图片大小？ 14
Delphi:为什么我有时会使用此代码获得I/O错误103？ 11
Delphi 5的Hashtable实现 9
知道硬盘驱动器在Delphi中的速度有多快 9
如何更改TEdit默认错误消息(NumbersOnly模式)？ 9
为什么MessageBox不会在同步线程上阻止应用程序？ 8
如何最好地在Delphi中创建HMI显示面板(用户自定义界面) 7
如何为整个项目设置$ RTTI指令？ 4
使用Delphi的条形码扫描仪 4
如何使用系统对话框图标加载图像列表 4
难疑归档
grep一个文件,但显示几个周围的行？ 3277
#include <filename>和#include"filename"有什么区别？ 2204
如何在JavaScript中清空数组？ 2198
检查变量是否是JavaScript中的字符串 1550
如何显示JavaScript对象？ 1520
从JSON文件中解析值？ 1400
如何在find中排除目录.命令 1250
如何使用INER JOIN与SQL Server删除？ 1181
在拉动期间解决Git合并冲突以支持其更改 1104
什么是"Linting"？ 1044