Оптимизация кода 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) * (Start^ and $00FF00FF)) shr 24) * $00010101; к томуже в процессе выяснилось, что функция вычисления цвета стыренная у Sha с блога, творит какое то непотребство с бмп и цвета близкие к черному (а может и просто черный) становятся белыми, а не серыми.Впрочем это так...потому что на удивление, это еще ничему не мешало и все норм работало )

ну а патом, уже вопрос, а нельзя ли тут чего ускорить еще?)

← →
Вова (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 должно быть больше толку.

Оптимизация кода 2. и еще не могу найти ошибку ) Найти похожие ветки