Подвисание при работе с большим динамическим массивом байтов

← →
Alik (2010-10-15 00:17) [0]

Добрый день,

Имеется массив -

RawData: array of Byte;
DataLen := 4708000;
SetLength(RawData, DataLen)

Размер массива составляет порядка 4.5 Мегабайт.
Необходимо максимально быстро вырезать определенные куски в данном массиве, так как это делается например в функции Delete(S, Index, Count);

Пробовал так
for i := Index to DataLen - Count - 1 do
RawData[i] := RawData[i+Count];

Это работает, но тормозит очень сильно (порядка 30 секунд).

Можно ли как то ускорить эту процедуру средствами API или через Assembler?

← →
Rouse_ © (2010-10-15 01:10) [1]

Можно, не обязательно грохать сами данные нарываясь на реаллоки, достаточно работать с записями через промежуточный список с указателями на записи из которого исключать не валидные записи. Ну а сам реаллок делать после полной процедуры удаления.

← →
Германн © (2010-10-15 03:29) [2]

> Rouse_ © (15.10.10 01:10) [1]

В приведенном обрывке кода вроде никаких реаллоков нет. Возможно они подразумеваются, но ...

← →
Anatoly Podgoretsky © (2010-10-15 04:16) [3]

Не надо делать это побайтно.

← →
RWolf © (2010-10-15 09:43) [4]

> Это работает, но тормозит очень сильно (порядка 30 секунд).

Бред. Вышеприведённый код выполняется мгновенно.

← →
DVM © (2010-10-15 10:47) [5]

> Пробовал так
> for i := Index to DataLen - Count - 1 do
> RawData[i] := RawData[i+Count];

Move не спасет отца русской демократии?

← →
han_malign (2010-10-15 10:53) [6]

> Вышеприведённый код выполняется мгновенно.

- если {$R-}
да и move() все же побыстрее будет...

А вот если надо вырезать много(N) маленьких кусков - то при последовательных удалениях время выполнения O(N*DataLen), тогда как при сквозной обработке*(см. [1]) - O(DataLen)...

← →
RWolf © (2010-10-15 13:13) [7]

> han_malign (15.10.10 10:53) [6]
> если {$R-}

да даже если R+, всё равно мгновенно.
включив вообще всю отладку, не выбрался даже за 50 мсек (на атлоне 3000); типичное время 16-32 мсек.

← →
Alik (2010-10-15 16:10) [8]

> RWolf © (15.10.10 13:13) [7]
>
>
> > han_malign (15.10.10 10:53) [6]
> > если {$R-}
>
> да даже если R+, всё равно мгновенно.
> включив вообще всю отладку, не выбрался даже за 50 мсек
> (на атлоне 3000); типичное время 16-32 мсек.
>

Я забыл упомянуть, что такая операция (вырезание части динамического массива) может выполняться несколько сот раз. Это используется для фильтрации нулей из первоначального массива, нули могут быть в любом месте и в любом кол-ве. Поэтому процедура и занимает столько времени!

← →
Alik (2010-10-15 16:12) [9]

> DVM © (15.10.10 10:47) [5]
>
>
> > Пробовал так
> > for i := Index to DataLen - Count - 1 do
> > RawData[i] := RawData[i+Count];
>
> Move не спасет отца русской демократии?

А как использовать Move для нашего массива (RawData: array of Byte)?
Ведь эта функция используется для переменной типа String!

← →
Sha © (2010-10-15 16:13) [10]

> Alik (15.10.10 16:10) [8]

Сделай циклом за один проход массива.

← →
Sha © (2010-10-15 16:15) [11]

И двигай только куски, в которых нет нулей

← →
Alik (2010-10-15 16:37) [12]

> Sha © (15.10.10 16:15) [11]
>
> И двигай только куски, в которых нет нулей

Все и так делается за один проход. Вот текст кода:

var
RawData: array of Byte;
ByteId, i, j: Integer;
DataLen: Integer;
CountZeros: Integer;
S: String;
begin
DataLen := 4608000;
SetLength(RawData, DataLen);

Далеее RawData наполняется значениями
и приступаем к выкидыванию нулей по такому алгоритму: Если кол-во последовательных нулей CountZeros меньше 4, то пропускаем, если CountZeros > 3, то вместо первого нуля пишем 255, а потом в следующих двух нулях пишем два байта (кол-во последовательных нулей), затем все следующие последовательные нули вырезаем и сокращаем длину массива на CountZeros - 3 элементов.

ByteId := -1;
repeat
Inc(ByteID);
CountZeros := 0;
while (RawData[ByteID] = 0) and (ByteID < DataLen) and (CountZeros < 65536) do begin
Inc(ByteID);
Inc(CountZeros);
end;
if CountZeros > 3 then begin
S := WordTo2BytesStr(CountZeros);
Dec(ByteID, CountZeros - 3);
RawData[ByteID - 3] := 255;
RawData[ByteID - 2] := Byte(S[1]);
RawData[ByteID - 1] := Byte(S[2]);
j := CountZeros - 3;
for i := ByteID to DataLen - j - 1 do
RawData[i] := RawData[i + j];
Dec(DataLen, j);
SetLength(RawData, DataLen);
end;
until ByteID >= DataLen;
end;

// преобразовывает целое число в строку из двух символов
function WordTo2BytesStr(Val: Word): String;
var
Temp: Word;
TempArr: array[0..1] of Byte absolute Temp;
begin
Temp := Val;
Result := chr(TempArr[1]) + chr(TempArr[0]);
end;

← →
Sha © (2010-10-15 16:45) [13]

Перепиши это без WordTo2BytesStr, string и SetLength внутри цикла.

← →
RWolf © (2010-10-15 16:48) [14]

> Alik (15.10.10 16:37) [12]
> for i := ByteID to DataLen - j - 1 do

то есть двигаешь массив с текущего индекса до конца.
а зачем?
почему бы не двигать только до следующей цепочки нулей?

← →
Alik (2010-10-15 16:57) [15]

> Sha © (15.10.10 16:45) [13]
>
> Перепиши это без WordTo2BytesStr, string и SetLength внутри
> цикла.

Без WordTo2BytesStr, string пробовал, они едят ничтожно малое время, так как это вычисляется только один раз для найденой последовательной цепочки нулей, вто время как дальнейшее двигание массива влево производит очень много операций = кол-во оставшихся справа элементов массива.

Без SetLength тоже пробовал, ничего не изменилось.

← →
Alik (2010-10-15 17:00) [16]

> RWolf © (15.10.10 16:48) [14]
>
>
> > Alik (15.10.10 16:37) [12]
> > for i := ByteID to DataLen - j - 1 do
>
> то есть двигаешь массив с текущего индекса до конца.
> а зачем?
> почему бы не двигать только до следующей цепочки нулей?

Вот пример исходного массива:
1 2 3 4 5 6 7 8 9 0 0 0 0 0 8 7 6 5 4 3 2 1 0 0 0 0 2 3 4 5 6 7 8 9

Вот пример выходного массива:
1 2 3 4 5 6 7 8 9 255 0 5 8 7 6 5 4 3 2 1 255 0 4 2 3 4 5 6 7 8 9

← →
RWolf © (2010-10-15 17:03) [17]

об чем я и говорю.
после первой итерации сдвигается блок 8 7 6 5 4 3 2 1 0 0 0 0 2 3 4 5 6 7 8 9
а можно было бы ограничиться сдвиганием 8 7 6 5 4 3 2 1

← →
Sapersky (2010-10-15 17:35) [18]

А зачем вырезать нули из исходного массива? Может, формировать второй массив по заданным правилам? Часть данных придётся копировать из первого, но копирований наверняка будет меньше, чем при вырезании.

Кстати: то, что ты делаешь, называется RLE-упаковка. Если это не учебное задание, имеет смысл поискать готовую реализацию. Или использовать ZLib, который сожмёт лучше (как архиватор Zip), и, вполне возможно, быстрее кривой самопальной реализации RLE.

> Sapersky (15.10.10 17:35) [18]

число копирований будет одинаковым, а вот нагрузка на кэш — больше, поэтому общая производительность алгоритма упадёт.

← →
Sapersky (2010-10-15 18:16) [20]

Да, точно, если с поправкой [17] - то одинаково.

> Alik (15.10.10 16:57) [15]
> пробовал, ничего не изменилось.

Плохо пробовал, пробуй еще раз [10]+[11]+[13] пока все не изменится.
А когда изменится, начни сдвигать по 4 байта (dword) за раз, оно снова изменится.

function RLE(p: pByteArray; len: integer): integer; var save, tmp: byte; read, write, count: integer; begin; if len<=3 then Result:=len else begin; dec(len); //индекс последнего байта save:=p[len]; //сохраняем последний байт p[len]:=0; if p[len-1]=0 then p[len]:=1; //меняем его так, чтобы на нем требовалось переключение read:=0; //прочитано байтов write:=0; //записано байтов repeat; dec(read); dec(write); repeat; //копируем не нули inc(read); inc(write); tmp:=p[read]; p[write]:=tmp; until tmp=0; //в write - индекс первого записанного нуля if read=len then begin; //если нуль был последним байтом p[write]:=save; //пишем вместо него сохраненное значение inc(write); break; end; count:=-read; //отсюда считаем количество нулей repeat; inc(read); until p[read]<>0; if read=len then inc(read); //если мы здесь, то последний байт в массиве обязан быть нулем count:=count+read; //было такое количество нулей подряд if count<=3 then begin; write:=write+count; p[write-1]:=0; //копируем последний нуль, может быть поверх первого if count=3 then p[write-2]:=0; //и средний, если надо end else while true do begin; if count>65535 then begin; //64k нулей или более p[write]:=255; p[write+1]:=255; //сжимаем только 64k-4 нулей p[write+2]:=252; write:=write+3; count:=count-65532; //оставляем несжатыми 4 и более нулей end else begin; p[write]:=255; p[write+1]:=count shr 8; //иначе сжимаем все p[write+2]:=count; write:=write+3; break; end end; until read>=len; Result:=write; end; end; procedure TForm1.Button1Click(Sender: TObject); const a: array[0..37] of byte= (1,2,3,4,5,6,7,8,9,0,0,0,0,0,8,7,6,5,4,3,2,1,0,0,0,0,2,3,4,0,5,0,6,7,8,9,0,0); //1 2 3 4 5 6 7 8 9 255 0 5 8 7 6 5 4 3 2 1 255 0 4 2 3 4 0 5 0 6 7 8 9 0 0 var Data: array of byte; i: integer; s: string; begin; SetLength(Data, High(a)+1); for i:=0 to High(a) do Data[i]:=a[i]; i:=RLE(@Data[0], Length(Data)); SetLength(Data, i); for i:=0 to Length(Data)-1 do s:=s + IntToStr(Data[i]) + " "; Edit1.Text:=s; end;

Особо не отлаживал.
Если нужна бОльшая скорость, первый вложенный repeat можно переписать, используя работу с двойными словами. Скорость возрастет еще почти в 4 раза, но при этом иногда группы из 4-6 нулей могут оставаться несжатыми.

> Alik (15.10.10 00:17)
> Можно ли как то ускорить эту процедуру средствами API или через Assembler?

Ускорения через Pascal [22] вроде достаточно :-)
Твои 4708000 байт обрабатываются менее одного тика системного таймера (менее 16 msec)

← →
Alik (2010-10-20 14:06) [24]

> Sha © (16.10.10 22:27) [22]
> function RLE(p: pByteArray; len: integer): integer;

Спасибо большое за код, а можно еще распаковщик получить?

Распаковщик тут http://guildalfa.ru/alsha/node/11

Подвисание при работе с большим динамическим массивом байтов Найти похожие ветки