Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Необходимо увеличить скорость работы функции


Автор: mardoc 26.4.2011, 09:32
Есть рабочая функция удаления записей в массиве
Код

type TproductRecord = record
        Numr:Integer;
        name :string[250];
        price:real;
        .....//еще куча др. полей
    end;
TproductArray = array of TproductRecord;

//Функция удаляет записей с ценой = 0 
procedure DeleteZerroPrice(var ProdArr:TproductArray);
var i: Integer;
      Last : integer;
begin
  Last:=High(ProdArr);
  i:=0;
  while i<=Last do
    begin
      if ProdArr[i].price=0 then
        begin
         if i <  Last then  move( ProdArr[i+1], ProdArr[ i ],
                                            (Last-i) * SizeOf(TproductRecord)  );
         setLength( ProdArr, Last );
         Last:=Last-1;
        end
       else i:=i+1;
    end;
end;


Необходимо увеличить скорость работы функции. Так как при массивах более 10тыс записей становится мягко говоря не комфортно smile

Автор: Snowy 26.4.2011, 10:15
Нужно просто SetLength вынести за пределы цикла.
Вместо изменения размера, заведи переменную, куда сохраняй нужный размер.
И уже по окончании цикла делай SetLength на нужный.
Именно SetLength и кушает процессор.

Автор: yahont7 26.4.2011, 14:15
Можно попробовать так:
Код

procedure DeleteZerroPrice(var ProdArr : TProductArray);
var
  i,
  BeginCount,
  DelCount, Last : Integer;
begin //Функция удаляет записей с ценой = 0
  Last := High(ProdArr);
  i := 0;
  BeginCount := Length(ProdArr); // Начальное число элементов
  DelCount := 0; // Количество удаленных элементов

  // Смещаем массив на местах удаленных элементов
  while i <= Last do
  begin
    if ProdArr[i].price = 0 then
    begin
      if i <  Last then  move( ProdArr[i+1], ProdArr[ i ],
                                            (Last-i) * SizeOf(TproductRecord)  );
      Inc(DelCount); // Подсчитываем число удаленных элементов
      Last:=Last-1;
    end else
     i:=i+1;
    end;

  SetLength( ProdArr, BeginCount - DelCount + 1); // Новый размер массива
end;

Автор: mardoc 26.4.2011, 17:04
Спасибо за ответы .
Сделал проще перенес setLength за цикл:
Код

procedure DeleteZerroPrice(var ProdArr:TproductArray);
var i: Integer;
      Last : integer;
begin
  Last:=High(ProdArr);
  i:=0;
  while i<=Last do
    begin
      if ProdArr[i].price=0 then
        begin
         if i <  Last then  move( ProdArr[i+1], ProdArr[ i ],
                                            (Last-i) * SizeOf(TproductRecord)  );
         Last:=Last-1;
        end
       else i:=i+1;
    end;
   setLength( ProdArr, Last+1 );
end;

код работает быстрее, но все равно медленно. :( 
Дело в том, что операции  move приходиться переносить большие блоки в памяти, массив большой очень, в нем хранятся много всего.
У меня, возможно, неверный подход к решению задачи!.  А задача такова: необходимо фильтровать данные в массиве (фильтр задает пользователь). Для меня идеал по скорости фильрации это EXCEL smile . Может у кого есть соображения на этот счет?  

Автор: MetalFan 26.4.2011, 17:29
Отказаться от массива в пользу связанных списков. Там удаление будет делаться в разы быстрее)
Ну или TList.

Автор: Snowy 26.4.2011, 18:50
Перемещать нужно не сами записи, а указатели на них.
Ну и раз уж массив нефиксированного размера, то действительно, для данной задачи больше подходят списки - TList и его потомки.

Автор: mardoc 26.4.2011, 19:28
С TList не хочется заводится слишком много кода переписывать. :(
Вот написал более-менее устраивающее решение (скорость раз в 100 быстрее), но у него есть свои минусы.
Код

procedure DeleteZerroPrice(var ProdArr:TproductArray);
var i: Integer;
      TempArr:TproductArray;
      Temp_i : integer;
begin
 setLength( TempArr, length(ProdArr) );
 for i:=0 to High(ProdArr) do
    begin
         if ProdArr[i].price <> 0 then
            begin
                  move( ProdArr[ i ], TempArr[ temp_i ],
                                                        SizeOf(TproductRecord)  );
                  temp_i:=temp_i+1;
            end;
    end;
   setLength( TempArr, temp_i );
   ProdArr:=TempArr;
end;


Добавлено @ 19:31
Цитата(Snowy @  26.4.2011,  18:50 Найти цитируемый пост)
Перемещать нужно не сами записи, а указатели на них.

О, а можно пример ? smile плззз

Автор: yahont7 26.4.2011, 19:55
Код

procedure DeleteZerroPrice(var ProdArr:TproductArray);
var i: Integer;
      TempArr:TproductArray;
      Temp_i : integer;
begin
  setLength( TempArr, length(ProdArr) );
 .....

  ProdArr:=TempArr; // 
end;

При каждом вызове этой процедуры, старый указатель на ProdArr будет затиратся новым TempArr, что приведет к утечки памяти, ибо весь стары динамический массив ProdArr будет оставаться в памяти а переменная ProdArr будет содержать указатель на вновь созданный TempArr..
С каждым вызовом процедуры удаления, оперативка будет грузится на целый (старый) массив ProdArr.

Потому в таком случае надо переиначить твой код след образом:
Код

procedure DeleteZerroPrice(var ProdArr:TproductArray);
var i: Integer;
      TempArr:TproductArray;
      Temp_i : integer;
begin
 setLength( TempArr, length(ProdArr) );
 for i:=0 to High(ProdArr) do
    begin
         if ProdArr[i].price <> 0 then
            begin
                  move( fcurr.ProductArr[ i ], TempArr[ temp_i ],
                                                        SizeOf(TproductRecord)  );
                  temp_i:=temp_i+1;
            end;
    end;
   setLength( TempArr, temp_i );
 //  вместо этого ProdArr:=TempArr;
  setLength( ProdArr, temp_i ); // Новый размер целевого массива
  ProdArr := Copy(TempArr,0,Length(TempArr)); // Копирование элементов TempArr в ProdArr
  // осовбодить память из под временного массива 
  Finalize(TempArr); // Вроде как грят можно и просто TempArr := nil;
end;

Автор: yahont7 26.4.2011, 20:24
Цитата

Цитата(Snowy @  26.4.2011,  18:50 Найти цитируемый пост)
Перемещать нужно не сами записи, а указатели на них.

О, а можно пример ? smile плззз

Проще перейти на использование TList. 
Но при этом придется 
Использовать запись в виде указателя.
Код

type TproductRecord = record
        Numr:Integer;
        name :string[250];
        price:real;
        .....//еще куча др. полей
    end;
   PProductRecord = TProductRecord^; // Объявляешь тип указатель на свою запись

  TProductArray = array of PProductRecord; // А массив так



Соответсвено изменится и правила доступа к массиву.. прежде чем туда записать новый элемент, нужно будет под этот элемент выделить память процедурой New (и при удалении элемента не забыть про процедуру Dispose)...

Так или иначе а лучше запись TProductRecord объявить как класс (за одно туда можно и функционал навесить в виде процедур и функций). А в качестве массива использовать хранитель указателей - объект TList.
Вот например как можно переписать запись:
Код

type 
  TProductRecord = class
    Numr:Integer;
    name :string[250];
    price:real;
        .....//еще куча др. полей
    // Можно наваять несколько конструкторов
    constructor Create; // Просто конструктор для создания объекта (внутри можно инициировать поля в НУ)
    constructor CreateAndAssign(var AValue : TProductRecord); // Создать объект и скопировать свойства целевого AValue
...

  end;

 
Добавление нового элемента в список 
Код

var
  FItemsProduct : TList;

....
....

// гдето в коде (где надо)
  FItemsProduct := TList.Create; // Создаем список

... 
// Добавляем новый элемент (автоматом создавая экземпляр в памяти)
  FItemsProduct.Add(TProductRecord.Create)
...

// Получаем доступ из списка
  TProductRecord(FItemsProduct[i]).Numr := 100;
  TProductRecord(FItemsProduct[i]).name := 'Пирожок с цементом'; // :)

// Можно компактнее
Var 
  lTemp : TProductRecord; // Переменная для хранения указателя (память под нее выделять не надо)
begin
  lTemp := TProductRecord(FItemsProduct[i]);
// А потом  
  lTemp.Numr := 100;
  lTemp.name := 'Пирожок с цементом'; // :)

...

// Удаление элемента из списка
  if TProductRecord(FItemsProduct[i]).price <> 0 then
  begin
     TProductRecord(FItemsProduct[i]).Free; // Разрушаем объект в памяти
     FItemsProduct.Delete(i); // Теперь удаляем указатель из списка 
  end;
...

// Удаление всех элементов (обязательно надо делать в том числе и пред разрушением самого списка 
// FItemsProduct если он не пуст)
  for i := 0 to FItemsProduct.Count - 1 do
    TProductRecord(FItemsProduct[i]).Free; // Разрушаем объект в памяти
  FItemsProduct.Clear; // Очищаем спиок

....
// Ну и когда не нужен объект списки то 
  FItemsProduct.free;


Както так в упрощенном виде.

Автор: mardoc 26.4.2011, 22:12
yahont7 Огромное спасибо за ответы. Реально помогли.
Попробую использовать TList в своих проектах.  

Автор: MetalFan 27.4.2011, 10:48
Цитата(yahont7 @  26.4.2011,  19:55 Найти цитируемый пост)
При каждом вызове этой процедуры, старый указатель на ProdArr будет затиратся новым TempArr, что приведет к утечки памяти, ибо весь стары динамический массив ProdArr будет оставаться в памяти а переменная ProdArr будет содержать указатель на вновь созданный TempArr..
С каждым вызовом процедуры удаления, оперативка будет грузится на целый (старый) массив ProdArr.

Путаешь recordы и классы.
Ничего там не будет "утекать".

Автор: imageman 2.5.2011, 21:13
  я так понимаю, ты первоначально делал перемещение всех записей от текущей до конца, а потом перешел к перемещению одной записи в новый массив.

Возможно будет несколько быстрее воспользоваться копированием?

Для record можно просто использовать присвоение (по типу ProdArr[0]:=ProdArr[100]).

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

И в сторону СУБД можно посмотреть (как универсальном хранилище данных).

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)