Вопрос о скорости петли Delphi - PullRequest
5 голосов
/ 20 января 2010

Есть ли более быстрый способ?Мне нужно добавить AA-ZZ к тысячам записей одновременно.

Просто список из 35 предметов занимает много времени, чтобы заполнить бесчисленный список из тысячи.


procedure Tmainform.btnSeederClick(Sender: TObject);
var
  ch,ch2:char;
  i:integer;
  slist1, slist2:TStrings;
begin
  slist1:= TStringList.Create;
  slist2:= TStringList.Create;
  slist1.Text :=queuebox.Items.Text;
  for ch := 'a' to 'z' do
    begin
      for ch2 := 'a' to 'z' do
        begin
          //</p>

      for I := 0 to slist1.Count - 1 do
        begin
        application.ProcessMessages; // so it doesn't freeze the application in long loops.  Not 100% sure where this should be placed, if at all.
         sleep(1);  //Without this it doesn't process the cancel button.
         if cancel then Break; 
         slist2.Add(slist1.Strings[i]+ch+ch2);
        end;
    end;
end;
insertsingle(slist2,queuebox);
freeandnil(slist1);
freeandnil(slist2);

end;

Спасибо за любую помощь

Ответы [ 10 ]

14 голосов
/ 20 января 2010

Есть пара очевидных проблем с вашим кодом.

Во-первых, вы тратите много циклов ЦП, вычисляя одни и те же значения снова и снова. Значения AA..ZZ не изменятся, поэтому нет необходимости строить их снова и снова. Попробуйте что-то вроде этого: создайте третий TStringList. Пройдите и заполните его всеми возможными перестановками AA..ZZ с вашей двойной петлей. После того, как все закончится, выполните цикл и объедините этот список предварительно вычисленных строк со значениями в slist1. Вы должны увидеть довольно большой импульс от этого.

(Или, если время абсолютно неоправданно, напишите небольшую небольшую программу, которая вычислит список перестановок и сохранит его в текстовый файл, а затем скомпилирует его в свое приложение как строковый ресурс, который можно загрузить во время выполнения.)

Во-вторых, и это, вероятно, то, что вас убивает, вы не должны иметь ProcessMessages и вызовов Sleep в самом внутреннем цикле. Sleep(1); звучит так, как будто это означает «спать в течение 1 миллисекунды», но Windows не обеспечивает такую ​​точность. То, что вы в конечном итоге получаете, это «спать по крайней мере 1 милисекунда». Он освобождает процессор до тех пор, пока Windows не вернется к нему, что обычно составляет порядка 16 миллисекунд. Таким образом, вы добавляете задержку в 16 мс (плюс столько, сколько занимает ProcessMessages) в очень узкий цикл, который, вероятно, займет всего несколько микросекунд для выполнения оставшейся части кода.

Если вам нужно что-то подобное для поддержания отзывчивости интерфейса, оно должно быть во внешнем цикле, а не во внутреннем, и вам, вероятно, даже не нужно запускать его каждую итерацию. Попробуйте что-то вроде if ch mod 100 = 0 then //sleep and process messages here. Предложение Крейга перенести эту задачу в рабочий поток также поможет, но только в том случае, если вы знаете достаточно о потоках, чтобы сделать это правильно. Они могут быть хитрыми.

11 голосов
/ 20 января 2010

Вы должны окружить свой код slist2.BeginUpdate() и slist2.EndUpdate(), чтобы не дать TStringList выполнять дополнительную обработку.

По моему опыту, вы получите очень значительное улучшение, используяменьше ProcessMessages(); Sleep(1); утверждений, как предлагается в других ответах.

Попробуйте переместить его чуть ниже первого цикла for и посмотрите, какое улучшение вы получите.

5 голосов
/ 20 января 2010

Пример того, как вы можете использовать вторичный поток для выполнения тяжелой работы.

Обратите внимание, что для 35 упомянутых вами элементов действительно не стоит начинать другую ветку. За несколько тысяч предметов игра меняется. Обработка 10.000 предметов занимает 10 секунд на моем настольном компьютере.

Некоторые преимущества многопоточности:

  • основной поток остается отзывчивым.
  • расчет можно остановить по желанию.

и исключить некоторые подводные камни:

  • необходимо позаботиться (в его текущей реализации) , чтобы не связываться с переданными строковыми списками во время заполнения
  • многопоточность добавляет сложности и является источником труднодоступных ошибок.

вставьте приведенный ниже код в наш любимый редактор, и все будет хорошо.

procedure TForm1.btnStartClick(Sender: TObject);
var
  I: Integer;
begin
  //***** Fill the sourcelist
  FSource := TStringList.Create;
  FDestination := TStringList.Create;
  for I := 0 to 9999 do
    FSource.Add(Format('Test%0:d', [I]));

  //***** Create and fire Thread
  FSeeder := TSeeder.Create(FSource, FDestination);
  FSeeder.OnTerminate := DoSeederDone;
  FSeeder.Resume;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  if Assigned(FSeeder) then
    FSeeder.Terminate;
end;

procedure TForm1.DoSeederDone(Sender: TObject);
var
  I, step: Integer;
begin
  I := 0;
  step := 0;
  while I < FDestination.Count do
  begin
    //***** Don't show every item. OutputDebugString is pretty slow.
    OutputDebugString(PChar(FDestination[I]));
    Inc(step);
    Inc(I, step);
  end;
  FSource.Free;
  FDestination.Free;
end;

{ TSeeder }

constructor TSeeder.Create(const source, destination: TStringList);
begin
  //***** Create a suspended, automatically freed Thread object.
  Assert(Assigned(source));
  Assert(Assigned(destination));
  Assert(destination.Count = 0);
  inherited Create(True);
  FreeOnTerminate := True; //***** Triggers the OnTerminate event
  FSource := source;
  FDestination := destination;
end;

procedure TSeeder.Execute;
var
  I, J: Integer;
  AString: string;
begin
  FDestination.BeginUpdate;
  try
    FDestination.Capacity := FSource.Count * 26 * 26;
    for I := 0 to Pred(FSource.Count) do
    begin
      AString := FSource[I];
      for J := 0 to Pred(26 * 26) do
      begin
        FDestination.Add(AString + Char(J div 26 + $41) + Char(J mod 26 + $41));
        if Terminated then Exit;
      end;
    end;
  finally
    FDestination.EndUpdate;
  end;
end;
4 голосов
/ 20 января 2010

OK. Я пытался оптимизировать ваш код. Для финальных тестов требуются некоторые тестовые данные.

Что я сделал (включая большинство идей Мейсона):

  • закомментируйте код "отмена" и "
  • дал типам и переменным более значимое имя
  • использовал имена, которые использует Delphi («Приложение» вместо «приложения» и т. Д.), Чтобы сделать его читаемым
  • переместил некоторую логику в "KeepUIGoing"
  • переместить вычисление суффиксов из основного цикла в цикл инициализации
  • сделал возможным использование TStringBuilder (который может быть намного быстрее, чем TStringList и доступен с Delphi 2009)

Ниже приведен модифицированный код, дайте мне знать, работает ли он для вас.

procedure TForm2.Button1Click(Sender: TObject);
{$define UseStringBuilder}
  procedure KeepUIGoing(SourceListIndex: Integer);
  begin
    if SourceListIndex mod 100 = 0 then
    begin
      Application.ProcessMessages;
      // so it doesn't freeze the application in long loops.  Not 100% sure where this should be placed, if at all.
      Sleep(1);
    end;
  end;
const
  First = 'a';
  Last = 'z';
type
  TRange = First .. Last;
  TSuffixes = array [TRange, TRange] of string;
var
  OuterIndex, InnerIndex: Char;
  SourceListIndex: Integer;
  SourceList, TargetList: TStrings;
  Suffixes: TSuffixes;
  NewLine: string;
{$ifdef UseStringBuilder}
  TargetStringBuilder: TStringBuilder; // could be way faster than TStringList
{$endif UseStringBuilder}
begin
  for OuterIndex := First to Last do
    for InnerIndex := First to Last do
      Suffixes[OuterIndex, InnerIndex] := OuterIndex + InnerIndex;

  SourceList := TStringList.Create;
  TargetList := TStringList.Create;
{$ifdef UseStringBuilder}
  TargetStringBuilder := TStringBuilder.Create();
{$endif UseStringBuilder}
  try
    SourceList.Text := queuebox.Items.Text;
    for OuterIndex := First to Last do
    begin
      for InnerIndex := First to Last do
      begin
        for SourceListIndex := 0 to SourceList.Count - 1 do
        begin
          KeepUIGoing(SourceListIndex);
          // if cancel then
          // Break;
          NewLine := SourceList.Strings[SourceListIndex] + Suffixes[OuterIndex, InnerIndex];
{$ifdef UseStringBuilder}
          TargetStringBuilder.AppendLine(NewLine);
{$else}
          TargetList.Add(NewLine);
{$endif UseStringBuilder}
        end;
      end;
    end;
{$ifdef UseStringBuilder}
    TargetList.Text := TargetStringBuilder.ToString();
{$endif UseStringBuilder}
    // insertsingle(TargetList, queuebox);
  finally
{$ifdef UseStringBuilder}
    FreeAndNil(TargetStringBuilder);
{$endif UseStringBuilder}
    FreeAndNil(SourceList);
    FreeAndNil(TargetList);
  end;
end;

- Йерун

4 голосов
/ 20 января 2010

Я бы посмотрел, сможешь ли ты сделать это за один цикл согласно комментарию.Также попробуйте сделать это в потоке, чтобы исключить вызовы Application.ProcessMessages и Sleep, не блокируя пользовательский интерфейс.

1 голос
/ 12 апреля 2012

Использование Delphi backgroundworker Компонент для этой цели может быть лучше, чем thread.it - ​​простой и основанный на событиях

  • Использовать код на основе событий. нет необходимости создавать класс
  • Добавить прогресс в процесс

Пример кода:

procedure TForm2.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  FSource := TStringList.Create;
  FDestination := TStringList.Create;

end;
procedure TForm2.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  try
    FSource.BeginUpdate;
    FSource.Clear;
    for I := 0 to 9999 do
      FSource.Add(Format('Test%0:d', [I]));
    BackgroundWorker1.Execute;
  finally
    FSource.EndUpdate;
  end;

end;



procedure TForm2.StopButtonClick(Sender: TObject);
begin
  BackgroundWorker1.Cancel;
end;



procedure TForm2.FormDestroy(Sender: TObject);
begin
 FreeAndNil(FSource);
 FreeAndNil(FDestination);
end;


procedure TForm2.BackgroundWorker1Work(Worker: TBackgroundWorker);
var
  I, J: Integer;
  AString: string;
begin
  FDestination.BeginUpdate;
  try
    FDestination.Capacity := FSource.Count * 26 * 26;
    for I := 0 to Pred(FSource.Count) do
    begin
      AString := FSource[I];
      for J := 0 to Pred(26 * 26) do
      begin
        FDestination.Add(AString + Char(J div 26 + $41) + Char(J mod 26 + $41));
        if Worker.CancellationPending then
          Exit;
      end;
      if I mod 10 = 0 then
        TThread.Sleep(1);
      Worker.ReportProgress((I * 100) div FSource.Count);
    end;
    Worker.ReportProgress(100); // completed

  finally
    FDestination.EndUpdate;
  end;
end;

procedure TForm2.BackgroundWorker1WorkProgress(Worker: TBackgroundWorker;
  PercentDone: Integer);
begin
  ProgressBar1.Position := PercentDone;
end;
1 голос
/ 10 марта 2010

Если вы хотите, чтобы во время цикла обрабатывались события, такие как нажатие кнопки «Отмена», достаточно вызвать Application.ProcessMessages. Если вы звоните это регулярно, но не слишком регулярно, например, 50 раз в секунду, тогда ваше приложение будет реагировать на кнопку «Отмена» без особого замедления. Application.ProcessMessages возвращается довольно быстро, если нет сообщений для обработки.

Этот метод подходит для относительно коротких вычислений (несколько секунд), от которых пользователь может ожидать. Для длинных вычислений более подходит фоновый поток. Тогда ваше приложение может оставаться полностью отзывчивым, особенно если у пользователя многоядерный процессор.

Вызов Sleep в основном потоке не позволяет вашему приложению обрабатывать события. Это позволяет другим приложениям что-то делать. Вызов Sleep действительно переводит ваше приложение (фактически, вызывающий поток) в спящий режим на требуемое количество времени или оставшуюся часть времени потока, в зависимости от того, что больше.

1 голос
/ 20 января 2010

Я знаю, что это не дает конкретного ответа на ваш вопрос, но если вас интересует алгоритм Delphi, Джулиан Бакнолл (технический директор DevExpress ) написал книгу по детальным алгоритмам Delphi

Томы Дельфи: алгоритмы и структуры данных :

  • Глава 1: Что такое алгоритм?
  • Глава 2: Массивы
  • Глава 3: Связанные списки, стеки и очереди
  • Глава 4: Поиск
  • Глава 5: Сортировка
  • Глава 6: Рандомизированные алгоритмы
  • Глава 7: Хеширование и хеш-таблицы
  • Глава 8: Двоичные деревья
  • Глава 9: Приоритетные очереди и Heapsort
  • Глава 10: автоматы и регулярные выражения
  • Глава 11: Сжатие данных
  • Глава 12: Дополнительные темы

Вы также можете получить его EZDSL (Easy Data Structures Library) для Delphi 2009 и Delphi 6-2007 .

1 голос
/ 20 января 2010

попробуйте этот пример кода - надеюсь, это немного поможет (Delphi 5 Ent./WinXP)

procedure TForm1.Button1Click(Sender: TObject);
var
   i,k: Integer;
   sourceList, destList: TStringList;
   ch1, ch2: char;
begin
   destList := TStringList.Create;
   sourceList := TStringList.Create;

   //some sample data but I guess your list will have 1000+
   //entries?
   sourceList.Add('Element1');
   sourceList.Add('Element2');
   sourceList.Add('Element3');

   try
      i := 0;
      while i < (26*26) do
      begin
         if (i mod 100) = 0 then
            Application.ProcessMessages;

         ch1 := char(65 + (i div 26));
         ch2 := char(65 + (i mod 26));

         for k := 0 to sourceList.Count -1 do
            destList.Add(Format('%s-%s%s', [sourceList.Strings[k], ch1, ch2]));
         Inc(i);
      end;

      Memo1.Lines.AddStrings(destList);
   finally
      FreeAndNil(destList);
      FreeAndNil(sourceList);
   end;
end;    

- Reinhard

0 голосов
/ 23 января 2010

, если вы ищете чистую скорость, просто разверните код в один цикл и запишите каждую строку как отдельное назначение. Вы можете написать программу, которая автоматически напишет для вас строки, а затем скопировать и вставить их в свой код. По сути, это будет самый быстрый способ. Также отключите все обновления, как указано выше.

procedure Tmainform.btnSeederClick(Sender: TObject);
var
  ch,ch2:char;
  i:integer;
  slist1, slist2:TStrings;
begin
  slist1:= TStringList.Create;
  slist2:= TStringList.Create;

  slist1.Text :=queuebox.Items.Text;

  slist2.BeginUpdate() 
     for I := 0 to slist1.Count - 1 do
        begin
        application.ProcessMessages; // so it doesn't freeze the application in long loops.  Not 100% sure where this should be placed, if at all.
         if cancel then Break; 
         slist2.Add(slist1.Strings[i]+'AA');
         slist2.Add(slist1.Strings[i]+'AB');
         slist2.Add(slist1.Strings[i]+'AC');
         ...
         slist2.Add(slist1.Strings[i]+'ZZ');
        end;
slist2.EndUpdate()
insertsingle(slist2,queuebox);
freeandnil(slist1);
freeandnil(slist2);
end;
...