Как в Delphi эффективно удалить большое количество пар из словаря TDictionary?

Question

У меня в Delphi есть словарь TDictionary<key,value> с парой десятков тысяч пар. Значения - record-ы со строками. Мне нужно удалить из него в один присест примерно 10..90% пар по некоторому условию (по ключам, если это имеет значение). Фильтр/условие заранее неизвестен. Вопрос, как это эффективно сделать (не тратя лишнего времени и памяти)?

Например вот так - неправильно (в Delphi 11), будут оставаться лишние элементы:

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

Если бы это был TList<>, то все просто - итерируем с хвоста к голове и Delete(I) (или еще лучше, идём со вторым счетчиком, замещаем ненужные элементы и обрезаем в конце).

Answer 1

Создал словарь с 13 млн элементов, ушло 5.1 секунд.

Удалил Remove элементы с чётными ключами - ушло 1.2 секунды. Вроде особо не за что бороться...

Удаление выполняет function TDictionary<K,V>.DoRemove, в её коде перелопачивания всей хэш-таблицы (типа постоянного сдвига массива) не видно. В хелпе по Remove: 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

Answer 2

Тестовый код:

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, Debug, на 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

БЛОГ НА HUSL

Как в Delphi эффективно удалить большое количество пар из словаря TDictionary?

Ответы (2 шт):