VPF::Необходимо увеличить скорость работы функции

mardoc

Дата 26.4.2011, 09:32 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 24.2.2011

Репутация: нет
Всего: нет

Есть рабочая функция удаления записей в массиве

Код


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

Это сообщение отредактировал(а) mardoc - 26.4.2011, 09:34

Snowy

Дата 26.4.2011, 10:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

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

yahont7

Дата 26.4.2011, 14:15 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 25.4.2011

Репутация: нет
Всего: нет

Можно попробовать так:

Код


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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 24.2.2011

Репутация: нет
Всего: нет

Спасибо за ответы .
Сделал проще перенес 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

. Может у кого есть соображения на этот счет?

Это сообщение отредактировал(а) mardoc - 26.4.2011, 17:06

MetalFan

Дата 26.4.2011, 17:29 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Отказаться от массива в пользу связанных списков. Там удаление будет делаться в разы быстрее)
Ну или TList.

--------------------

There are always someone smarter than you...

Snowy

Дата 26.4.2011, 18:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

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

mardoc

Дата 26.4.2011, 19:28 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 24.2.2011

Репутация: нет
Всего: нет

С 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

плззз

Это сообщение отредактировал(а) mardoc - 26.4.2011, 20:09

yahont7

Дата 26.4.2011, 19:55 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 25.4.2011

Репутация: нет
Всего: нет

Код


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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 25.4.2011

Репутация: нет
Всего: нет

Цитата

Цитата(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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 24.2.2011

Репутация: нет
Всего: нет

yahont7 Огромное спасибо за ответы. Реально помогли.
Попробую использовать TList в своих проектах.

MetalFan

Дата 27.4.2011, 10:48 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Цитата(yahont7 @ 26.4.2011, 19:55

)

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

--------------------

There are always someone smarter than you...

imageman

Дата 2.5.2011, 21:13 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 66
Регистрация: 30.9.2004

Репутация: 1
Всего: 1

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

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

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

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

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

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »