主页 / 问题 / 1577348
Accepted
Kromster
Asked:2024-04-23 02:55:43 +0000 UTC2024-04-23 02:55:43 +0000 UTC

如何有效地从 Delphi 中的 TDictionary<key,value> 字典中删除大量对？

  • 772

我有一本德尔福词典，TDictionary<key,value>里面有几万对。值是带有字符串的记录。我需要根据某种条件一次性删除大约 10..90% 的对（通过按键，如果这很重要）。过滤器/条件预先未知。问题是如何有效地做到这一点（不浪费额外的时间和内存）？

例如，这是不正确的（在Delphi 11中），会留下额外的元素：

for var i in Dict.Keys do
 if i ... then
   Dict.Remove(i);

如果是TList<>，那么一切都很简单 - 我们从尾部迭代到头部Delete(I)（或者更好的是，使用第二个计数器，替换不必要的元素并在末尾切断）。

delphi

2 个回答

  1. 创建一个包含 1300 万个元素的字典，花费了 5.1 秒。

    已删除 删除具有偶数键的元素 - 花费了 1.2 秒。似乎没有什么值得争的...

    删除是由 执行的function TDictionary<K,V>.DoRemove，在其代码中整个哈希表的铲除（例如永久数组移位）是不可见的。在删除帮助中：This is an O(1) operation

    已更改 -Dict.Keys.ToArray创建键数组的副本。

    var
  Dict: TDictionary<Integer, string>;
  i, j: Integer;
  t: DWord;
begin
  Dict := TDictionary<Integer, string>.Create;
  Randomize;
  t := GetTickCount;
  for i := 1 to 20000000 do begin
    j := Random(20000000);
    if not Dict.ContainsKey(j) then
      Dict.Add(j, 'asdfasdf');
  end;
  Memo1.Lines.Add((GetTickCount - t).ToString + ' ' + Dict.Count.ToString);
  t := GetTickCount;
 
 {for i := 1 to 10000000 do
    if Dict.ContainsKey(i*2) then
       Dict.Remove(i*2); } 

 for i in Dict.Keys.ToArray do
   if i mod 2 = 0 then
      Dict.Remove(i);

  Memo1.Lines.Add((GetTickCount - t).ToString + ' ' + Dict.Count.ToString);

    输出到~i5-4440（时间以毫秒为单位，字典大小）

    5078 12662156
1203 6330280

    输出最后一个片段的两次重复

    5485 12658135
1390 6328059
141 6328059
141 6328059
    • 3
  2. Best Answer

    测试代码：

    procedure TForm1.FillDict;
begin
  fDict.Clear;
  var t := GetTickCount;
  for var i := 1 to 3000000 do
  begin
    var tr: Integer;
    tr := i; //Random(3000000);
    fDict.TryAdd(tr, 'asdf'+IntToStr(i));
  end;
end;

procedure TForm1.TestRemove;
begin
  var t := GetTickCount;
  for var i in fDict do
    if i.Key mod 2 = 0 then
      fDict.Remove(i.Key);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestRemoveKeys;
begin
  var t := GetTickCount;
  for var i in fDict.Keys do
    if i mod 2 = 0 then
      fDict.Remove(i);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestToArrayAndRemove;
begin
  var t := GetTickCount;
  var a := fDict.ToArray;
  for var i in a do
    if i.Key mod 2 = 0 then
      fDict.Remove(i.Key);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestToArrayInPlaceAndRemove;
begin
  var t := GetTickCount;
  for var i in fDict.ToArray do
    if i.Key mod 2 = 0 then
      fDict.Remove(i.Key);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestToArrayKeysAndRemove;
begin
  var t := GetTickCount;
  var a := fDict.Keys.ToArray;
  for var i in a do
    if i mod 2 = 0 then
      fDict.Remove(i);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestToArrayAndRemoveReverse;
begin
  var t := GetTickCount;
  var a := fDict.ToArray;
  for var i := High(a) downto 0 do
    if a[i].Key mod 2 = 0 then
      fDict.Remove(a[I].Key);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestToArrayKeysAndRemoveReverse;
begin
  var t := GetTickCount;
  var a := fDict.Keys.ToArray;
  for var i := High(a) downto 0 do
    if a[i] mod 2 = 0 then
      fDict.Remove(a[I]);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestToArrayClearAndReadd;
begin
  var t := GetTickCount;
  var a := fDict.ToArray;
  fDict.Clear;
  for var i in a do
    if i.Key mod 2 = 0 then
      fDict.Add(i.Key, i.Value);
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

procedure TForm1.TestNewDict;
begin
  var t := GetTickCount;
  var newDict := TDictionary<Integer, string>.Create;
  for var i in fDict do
    if i.Key mod 2 = 0 then
      newDict.Add(i.Key, i.Value);
  fDict.Free;
  fDict := newDict;
  Memo1.Lines.Add(Format('%d items left in %dms', [fDict.Count, GetTickCount - t]));
end;

    以及 Delphi 11.3 在 i7-1355U 上调试的结果。经过多次运行测试，包括 无序 - 相对时间 +/- 相同。在 Release 中，一切都快一点，但相对值的分布方式相同：

    Remove
1613196 items left in 234ms  <<<--- Остаются лишние элементы
1503226 items left in 78ms
----------
RemoveKeys
1613196 items left in 219ms  <<<--- Остаются лишние элементы
1503226 items left in 47ms
----------
ToArrayAndRemove
1500000 items left in 422ms
1500000 items left in 140ms
----------
ToArrayInPlaceAndRemove
1500000 items left in 516ms
1500000 items left in 141ms
----------
ToArrayKeysAndRemove
1500000 items left in 235ms   <<<--- Почти самый быстрый
1500000 items left in 31ms
----------
ToArrayAndRemoveReverse
1500000 items left in 344ms
1500000 items left in 109ms
----------
ToArrayKeysAndRemoveReverse   <<<--- Самый быстрый
1500000 items left in 218ms
1500000 items left in 32ms
----------
ToArrayAndReadd
1500000 items left in 1125ms
1500000 items left in 2032ms
----------
NewDict
1500000 items left in 1156ms
1500000 items left in 2078ms
    • 2

相关问题