Форум: "Начинающим";
Текущий архив: 2014.08.03;
Скачать: [xml.tar.bz2];
ВнизОптимизация кода 2. и еще не могу найти ошибку ) Найти похожие ветки
← →
Вова (2013-09-14 21:01) [0]
function ScanLineBordersArray(tBmp: Tbitmap; var M: TMass;
k: integer = 10): Boolean;
var
MidIntensity: integer;
diff: integer;
diff2: integer;
Fon: integer;
MDest: TArrInt;
i, h, w, count, XCount: integer;
Start, Stop, Stop1: pInteger;
midDiffX, midDiffY: integer;
p, pw, p1, pDest, pwDest, p1Dest: pByte;
begin
Result := false;
if (tBmp.Width <2) or (tBmp.Height < 2) then
exit;
// белый с черным перепутаны местами, чтобы не рисовать фон, т.к. при соз
// дании массива итак все ячейки = 0
diff := 0;
MidIntensity := 0;
midDiffX := 0;
midDiffY := 0;
SetLength(MDest, M.size);
// проход 1, вычисляем среднюю яркость
w := tBmp.Width - 1;
h := tBmp.Height - 1;
Start := tBmp.ScanLine[h];
Stop := tBmp.ScanLine[h];
Stop := Start;
inc(Stop, (tBmp.Width) * (h));
p := @M.Mass[0];
pw := p; // пиксель свеху
p1 := p; // пиксель слева
// Первую точку присвоим массиву перед циклом, чтобы не нужно было
// в цикле проверять что мы ее уже прошли, в дальнейшем, в начале каждой строки
// за предыдущий пиксель, для первого в строке будет считаться последний пиксель предыду
// щей строки, это не совсем корректно, зато ничего не надо проверять и все быстро
// и в любом случае там перепад нельзя посчитать.
p^ := (((150 * 256) * Start^ + (29 * 256 * 256 - 150 * 256 + 77) * (Start^ and
$00FF00FF)) shr 24) * $00010101;
inc(Start);
inc(p);
// Первую строку пройдем в отдельном цикле, чтобы не нужно было все время
// проверять в цикле, что ее уже прошли
Stop1 := Start;
inc(Stop1, tBmp.Width); // останавливаемся в конце строки
repeat
p^ := (((150 * 256) * Start^ + (29 * 256 * 256 - 150 * 256 + 77) *
(Start^ and $00FF00FF)) shr 24) * $00010101;
midDiffX := midDiffX + ABS(p1^ - p^);
MidIntensity := MidIntensity + p^; // средняя яркость
inc(Start);
inc(p);
inc(p1);
until Start = Stop1;
// Далее пробегаем все остальное
repeat
p^ := (((150 * 256) * Start^ + (29 * 256 * 256 - 150 * 256 + 77) *
(Start^ and $00FF00FF)) shr 24) * $00010101;
midDiffX := midDiffX + ABS(p1^ - p^); // средний перепад по X
MidIntensity := MidIntensity + p^; // средняя яркость
midDiffY := midDiffY + ABS(pw^ - p^); // средний перепад по У
inc(Start);
inc(p);
inc(pw);
inc(p1);
until Start = Stop;
MidIntensity := Round(MidIntensity / ((tBmp.Width) * (tBmp.Height - 1)));
midDiffX := Round(midDiffX / ((tBmp.Width) * (tBmp.Height - 1))) + k;
midDiffY := Round(midDiffY / ((tBmp.Width) * (tBmp.Height - 1))) + k;
Fon := 0;
// Сравним все точки со средней яркостью, и отнимем те что темнее средней
// яркости от тех, которые ярче. Таким образом, если Fon будет отрицательным,
// То будем считать, что фон темнее средней яркости, иначе фон ярче средней
// яркости (каких точек больше те и фон).
// проход 2, выясняем что есть фон, а что нет.
repeat
dec(p);
if MidIntensity >= p^ then
dec(Fon)
else
inc(Fon);
until p = @M.Mass[0];
// проход 3
p := @M.Mass[M.Xsize]; // начинаем идти со второй строки
pw := @M.Mass[0]; // пиксель свеху
p1 := @M.Mass[M.Xsize - 1]; // пиксель слева
pDest := @MDest[M.Xsize];
pwDest := @MDest[0];
p1Dest := @MDest[M.Xsize - 1];
count := M.size;
XCount := M.Xsize - 1;
if Fon <= 0 then
// Если фон темнее средней яркости, то точку ставим
// в более яркой точке.
begin
repeat
inc(p);
inc(pw);
inc(p1);
inc(pDest);
inc(pwDest);
inc(p1Dest);
dec(count);
repeat
// по оси x
diff := p1^ - p^;
diff2 := ABS(diff);
if diff2 > midDiffX then
// Если перепад выше среднего, нужно поставить точку
// вопрос где?
if diff > 0 then
// и предыдущая точка ярче текущей, то ставим точку в предыдущей
p1Dest^ := 255
else // иначе в текущей
pDest^ := 255;
// по оси Y
diff := pw^ - p^;
diff2 := ABS(diff);
if diff2 > midDiffY then
// Если перепад выше среднего, нужно поставить точку
// вопрос где?
if diff > 0 then
// и предыдущая точка ярче текущей, то ставим точку в предыдущей
pwDest^ := 255
else // иначе в текущей
pDest^ := 255;
inc(p);
inc(pw);
inc(p1);
inc(pDest);
inc(pwDest);
inc(p1Dest);
dec(count);
dec(XCount);
until XCount = 0;
XCount := M.Xsize - 1;
until count = 0;
end
else
begin
// если фон светлее средней яркости
repeat
// пропускаем первый ряд
inc(p);
inc(pw);
inc(p1);
inc(pDest);
inc(pwDest);
inc(p1Dest);
dec(count);
repeat // по оси x
diff := p1^ - p^;
diff2 := ABS(diff);
if diff2 > midDiffX then
// Если перепад выше среднего, нужно поставить точку
if diff < 0 then
// и текущая точка ярче предыдущей, то ставим точку
// в предыдущей (типа там объект)
p1Dest^ := 255
else // иначе в текущей
pDest^ := 255;
// по оси Y
diff := pw^ - p^;
diff2 := ABS(diff);
if diff2 > midDiffY then
// Если перепад выше среднего, нужно поставить точку
// вопрос где?
if diff < 0 then
// и предыдущая точка ярче текущей, то ставим точку в предыдущей
pwDest^ := 255
else // иначе в текущей
pDest^ := 255;
inc(p);
inc(pw);
inc(p1);
inc(pDest);
inc(pwDest);
inc(p1Dest);
dec(count);
dec(XCount);
until XCount = 0;
XCount := M.Xsize - 1;
until count = 0;
end;
M.NewMassSize(0);
M.Mass := MDest;
MDest := nil;
Result := true;
end;
← →
Вова (2013-09-14 21:01) [1]вообщем оптимизировал я свою функцию и вот все норм работало. и вот после того как я нафигачил код после "// проход 3"
начала твориться какая то непонятная фигня. Потому что во первых есть изображения на которых все совершенно замечательно отрабатывает, и прямо скажем их большинство) А есть одно, на котором отрабатывает и это и все что после него, т.е. массив совершенно замечательно читается, заполнен значениями, его видно в отладчике, все отрабатывает, но если сделать M.Free, вылазит ошибка
First chance exception at $00402F8F. Exception class $C0000005 with message "access violation at 0x00402f8f: write of address 0x00ffffff". Process SDIAPP.exe (20084)
Причем если вызвать M.Free сразу же после этой функции результат тот же, т.е. фигня случается где то тут, а т.к. до этого код до "// проход 3" уже и был такой, то значит косяк после этого коммента ) равно как и последние 4 строчки всегда были такими же...
Если точнее то в деструкторе класса вызывается SetLength(fMass, 0); и в этот момент и вылетает ошибка. И вот то есть я понял, что видимо я куда то указателем не туда тыкнул, но не могу понять куда. Вечер секса с отладчиком ни к чему не привел )
type
TArrInt = array of byte;
TMass = class
Private
fMass: TArrInt;
fXsize, fYsize, fsize: integer;
Protected
Public
constructor Create();
destructor Destroy; override;
Procedure NewMassSize(s:integer);
Function ConvertToBmp():TBitmap;
Function PaintMass(): Boolean;
Property Xsize: integer read fXsize write fXsize;
Property Ysize: integer read fYsize write fYsize;
Property size : integer read fsize write fsize;
Property Mass : TArrInt read fMass write fMass;
end;
destructor TMass.Destroy;
begin
SetLength(fMass, 0);
fMass := nil;
inherited;
end;p^ := (((150 * 256) * Start^ + (29 * 256 * 256 - 150 * 256 + 77) *
к томуже в процессе выяснилось, что функция вычисления цвета стыренная у Sha с блога, творит какое то непотребство с бмп и цвета близкие к черному (а может и просто черный) становятся белыми, а не серыми.Впрочем это так...потому что на удивление, это еще ничему не мешало и все норм работало )
(Start^ and $00FF00FF)) shr 24) * $00010101;
ну а патом, уже вопрос, а нельзя ли тут чего ускорить еще?)
← →
Вова (2013-09-14 21:14) [2]а в идеале как запилить этот код на GPU ))))
← →
Вова (2013-09-14 21:20) [3]
> p^ := (((150 * 256) * Start^ + (29 * 256 * 256 - 150 * 256
> + 77) *
> (Start^ and $00FF00FF)) shr 24) * $00010101; к томуже
> в процессе выяснилось, что функция вычисления цвета стыренная
> у Sha с блога, творит какое то непотребство с бмп и цвета
> близкие к черному (а может и просто черный) становятся белыми,
> а не серыми.Впрочем это так...потому что на удивление,
> это еще ничему не мешало и все норм работало )
нет, становятся черными.....картинка то при выводе у мну инвертирутся. Вообщем этот пункт не проблема.
← →
Sapersky (2013-09-15 01:17) [4]"Начинаем идти со второй строки", но при этом count := M.size, может M.size - M.Xsize тогда?
Формула Sha рассчитана на преобразование 24->24, если правильно помню, а не 32->8.
Выделение памяти MDest делается зачем-то каждый раз.
Ну и в целом код выглядит страшненько... зря ты копируешь стиль Sha, это для хакеров 80-го левела (причём прикованных за ногу к своему коду). Можно написать проще и понятнее, при этом (почти) не медленнее.
← →
Вова (2013-09-15 01:59) [5]
> может M.size - M.Xsize тогда?
Да, это оно, спасибо!
> Формула Sha рассчитана на преобразование 24->24, если правильно
> помню, а не 32->8.
в его блоге речь вроде как раз о 32
> Выделение памяти MDest делается зачем-то каждый раз.
всмысле? он же локальный...а входные картинки всегда разного размера.
> Ну и в целом код выглядит страшненько... зря ты копируешь
> стиль Sha, это для хакеров 80-го левела (причём прикованных
> за ногу к своему коду).
Зато как вставляет! Чувааак!
еще поменял массивы местами, чтобы в конце не нужно было из одного в другой копировать.
← →
Sapersky (2013-09-15 17:25) [6]
> в его блоге речь вроде как раз о 32
Да, 32->32. Тогда * $00010101 лишнее. Это умножение распихивает полученный байт в компоненты RGB, а у тебя 8 бит.
> всмысле? он же локальный...а входные картинки всегда разного
> размера.
Считается, что в заточенных под скорость процедурах лучше не выделять память на "на лету"... хотя с FastMM возможно уже и быстро.
Попробуй в качестве эксперимента заменить на глобальную переменную без изменения размера (заранее установить максимальный). Если будет эффект, то можно сделать, например, класс для обработки картинок, у которого все эти массивы будут внутри.
← →
Вова (2013-09-16 13:18) [7]я достиг дзен? больше нечего оптимизировать?)
← →
Sapersky (2013-09-16 18:18) [8]Сейчас градиенты (ABS(p1^ - p^), ABS(pw^ - p^)) считаются два раза, можно попробовать на первом проходе сохранять их в какой-то буфер. Но не факт, что поможет - если картинка большая, а кэш маленький, то доступ к памяти будет довольно дорогим удовольствием.
Ну ещё может вынести разные этапы обработки в отдельные функции, дельфийский оптимизатор обычно при этом лучше справляется. Это может дать процентов 5-10, и то если повезёт.
Для суммы градиентов есть подходящая команда в MMX/SSE: PSADBW, она делает midDiffY := midDiffY + ABS(pw^ - p^) для 8 байт сразу, хотя ускорение в 8 раз не гарантируется, особенно для горизонтальной суммы, там невыровненный доступ к памяти. Это применимо если не пойдёт оптимизация с сохранением градиентов в буфер, ну и если ты внезапно научишься писать на ассемблере :)
← →
Sapersky (2013-09-16 20:04) [9]Всё-таки написал сам вариант с MMX, интересно стало, насколько ускорится.
Получилось раз в 15, и даже от выравнивания не особо зависит.
Хотя это чистое везение - нашлась хорошо подходящая под конкретный случай команда. Градиент без суммы на MMX будет, как ни странно, сложнее и медленнее.
Type
PByteArr = ^TByteArr;
TByteArr = array [0..MAXINT-1] of Byte;
DByteArr = array of Byte;
// размер округляется на 8 байт
procedure GetDiffA(Src : PByteArr; OffsY, Cnt : Integer; ResX, ResY : PInteger);
asm
shr ecx, 3
db $0F,$EF,$E4 /// pxor mm4, mm4
db $0F,$EF,$ED /// pxor mm5, mm5
@@mix:
db $0F,$6F,$00 /// movq mm0, [eax]
db $0F,$6F,$0C,$10 /// movq mm1, [eax + edx]
db $0F,$6F,$50,$01 /// movq mm2, [eax + 1]
db $0F,$6F,$D8 /// movq mm3, mm0
db $0F,$F6,$C1 /// psadbw mm0, mm1
db $0F,$F6,$DA /// psadbw mm3, mm2
db $0F,$FE,$E0 /// paddd mm4, mm0
db $0F,$FE,$EB /// paddd mm5, mm3
add eax, 8
dec ecx
jnz @@mix
db $0F,$7E,$E0 /// movd eax, mm4
db $0F,$7E,$EA /// movd edx, mm5
mov ecx, ResX
mov [ecx], edx
mov ecx, ResY
mov [ecx], eax
db $0F,$77 /// emms
end;
// для сравнения
procedure GetDiff(Src : PByteArr; OffsY, Cnt : Integer; ResX, ResY : PInteger);
Var n, sx, sy : Integer;
begin
sx := 0; sy := 0;
For n:=0 to Cnt-1 do begin
Inc( sx, Abs(Src[n] - Src[n+1]) );
Inc( sy, Abs(Src[n] - Src[n+OffsY]) );
end;
ResX^ := sx; ResY^ := sy;
end;
procedure TForm1.Button4Click(Sender: TObject);
Const Size = 1024;
Width = 32;
Cycles = 1024 * 512;
Var n : Integer;
pa : PByteArr;
a : DByteArr;
ResX, ResY : Integer;
S: DWord;
begin
//pa := Arr_Aligned(a, Size+1, 3);
SetLength(a, Size+1);
// + лишний байт, чтобы не проверять гор. градиент на выход за пределы
pa := @a[0];
For n:=0 to Size-1 do pa[n] := n;
pa[Size] := pa[Size-1]; // лишний байт = последний
ResX := 0; ResY := 0;
S := GetTickCount;
For n:=0 to Cycles-1 do
GetDiffA(@pa[Width], -Width, (Size - Width), @ResX, @ResY);
// со второй строки, первую строку и "хвост" от округления размера считать отдельно
S := GetTickCount - S;
Caption := InttoStr(S) + " " + InttoStr(ResX) + " " + InttoStr(ResY);
end;
← →
Вова (2013-09-18 22:31) [10]буфер это по 2 байта на 1 diff(-255 до 255), а их 2, т.е. 4 байта на пиксель. + если еще по модулю хранить, еще 2 байта на пиксель. + яркость хранить еще байт на пиксель итого 7 байт на пиксель. если память на лету не выделять, то это 2 двухбайтовых массива и три однобайтовых, каждый размером с полный скрин ) т.е. это еще + 2 скриншота почти или около 12 мб ОЗУ ) может как нибудь подешевле это можно провернуть?))
← →
Sapersky (2013-09-19 01:00) [11]А, тебе ещё и знак нужен. Сразу не заметил, поэтому посчитал, что влезет в два байта.
Хотя и с двумя байтами (сейчас прикинул по простенькому тесту) ускорение от буферизации не впечатляющее, процентов 15.
От суммы градиентов на MMX должно быть больше толку.
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2014.08.03;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.002 c