Ускорение работы с растровой графикой(Загадки одного бита)

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Ускорение работы с растровой графикой(Загадки одного бита)

Сообщение Alex2013 » 27.10.2017 18:08:41

Вообщем решил я как писал в планах пробовать использовать одно битовые битмапы для ускорения анализа изображений и распознавания меток ...
Прямо "на живо" в проект добавить увы не получилось ....
Сделал согласно "Заветам zub-а " не сколько тестовых программ
Вот самая простая ...

Код: Выделить всё
unit BTun1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons, StdCtrls;

type

  { TBTForm }

  TBTForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject); // Конверсия
    procedure Button3Click(Sender: TObject);.// Тест
  private

  public
    const B1:TBitmap=nil;
  end;

var
  BTForm: TBTForm;

implementation

{$R *.lfm}

{ TBTForm }

// Загрузка (Картинка должна быть 24 бита и бинаризированная (два цвета черный и "не черный") )
procedure TBTForm.Button1Click(Sender: TObject);
Var f:String;
begin
GetDir(0,F);
OpenDialog1.InitialDir:=F;
OpenDialog1.FileName:='*.bmp;*.jpg;*.png';
If OpenDialog1.Execute then begin
image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;
end;

// Конверсия в 1 Бит
procedure TBTForm.Button2Click(Sender: TObject);
Type A=Array[0..1] Of byte;
var X,Y:Integer;
  BA,ba2:^A;
begin

   if B1= nil then b1:=TBitmap.Create else exit;
   B1.PixelFormat:=pf1bit;
   b1.SetSize(image1.Picture.Bitmap.Width,image1.Picture.Bitmap.Height);
For Y:=0 To b1.Height-1 do
Begin
b1.BeginUpdate;
ba:=b1.ScanLine[y];Ba2:=image1.Picture.Bitmap.ScanLine[y];
For X:=0 To B1.Width-1 do
begin

    If BA2^[x * 3]+BA2^[x * 3+1]+BA2^[x * 3+2]<>0
      then  Ba^[X div 8 ]:=Ba^[X div 8 ] or  (1 shr 7-(x mod 8) );
end;
b1.EndUpdate;
end;
   //b1.Canvas.Draw(0,0,image1.Picture.Bitmap);
    image2.Picture.Bitmap.
    SetSize(B1.Width,b1.Height);

    image2.Picture.Bitmap.Canvas.Draw(0,0,b1);
    label3.Caption:=' Размер  24 бита°: '+
    IntToStr(Image1.Picture.Bitmap.RawImage.DataSize)+' Размер 1 бит‚ : '+
    IntToStr(B1.RawImage.DataSize);
end;
// Тест
procedure TBTForm.Button3Click(Sender: TObject);

Type A=Array[0..1] Of byte;
var X,Y:Integer;
  BA,ba2:^A;
myTime:TDateTime;
ts:String;
begin
if B1= nil then exit;
myTime:=now;
For Y:=0 To b1.Height-1 do
begin
image1.Picture.Bitmap.BeginUpdate;
Ba2:=image1.Picture.Bitmap.ScanLine[y];
for X:=0 To B1.Width-1 do
begin
    BA2^[x * 3]  :=Not BA2^[x * 3];
    BA2^[x * 3+1]:=Not BA2^[x * 3+1];
    BA2^[x * 3+2]:=Not BA2^[x * 3+2];
end;
image1.Picture.Bitmap.endUpdate;
end;
image1.Refresh;
str((now-myTime)*10e4:2:5,ts);
Label1.Caption:='Время 24 Bit: '+ts;

myTime:=now;
For Y:=0 To b1.Height-1 do begin
b1.BeginUpdate;
ba:=b1.ScanLine[y];
For X:=0 To B1.Width-1 do
begin
  if  x mod 8 =0 then  Ba^[X div 8 ]:= not Ba^[X div 8 ]  ;
end;
b1.endUpdate;
end;
str((now-myTime)*10e4:2:5,ts);
Label2.Caption:='Время1 Bit: '+ts;
image2.Picture.Bitmap.Canvas.Draw(0,0,b1);
end;

end.


Сразу возникла непонятка обычно нормально работающий с разной битностью Canvas.Draw ( b1.Canvas.Draw(0,0,image1.Picture.Bitmap); ) в 1 бит копировать отказался ...
Ну если гора не идет нам навстречу .... это с ее стороны как минимум не вежливо ! :D
Поэтому конвертирую сам !
Код: Выделить всё
For Y:=0 To b1.Height-1 do
Begin
b1.BeginUpdate;
ba:=b1.ScanLine[y];Ba2:=image1.Picture.Bitmap.ScanLine[y];
For X:=0 To B1.Width-1 do
begin

    If BA2^[x * 3]+BA2^[x * 3+1]+BA2^[x * 3+2]<>0
      then  Ba^[X div 8 ]:=Ba^[X div 8 ] or  (1 shr 7-(x mod 8) );
end;
b1.EndUpdate;
end;

Причем работает даже если убрать b1.BeginUpdate; и b1.EndUpdate; (Интересно почему ? )

На третью кнопку цепляю тест времени исполнения простершей инверсии изображения ...
Вуаля! ускорение примерно в четыре раза (...0.09с против 0.02с)
Почему не в ожидаемые 8 раз не понятно но и это не плохо ... :idea:

И так вопросы :
1 Как сделать быстрый доступ к пикселю на запись и чтение ?
(Способ вроде Ba^[X div 8 ]:=Ba^[X div 8 ] or (1 shr 7-(x mod 8 ) ) ; не выглядит особо оптимальным ....)

2 Почему не работает b1.Canvas.Draw(0,0,image1.Picture.Bitmap); но работает image2.Picture.Bitmap.Canvas.Draw(0,0,b1); ?
В 1 бит конвертировать не получается, а вот обратно сколько угодно !

3 С чем быстрее работать с битмапом в 1 бит или 1 байт (8 бит ) ?
Alex2013
энтузиаст
 
Сообщения: 697
Зарегистрирован: 03.04.2013 11:59:44

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение olegy123 » 27.10.2017 21:59:11

Alex2013 писал(а):3 С чем быстрее работать с битмапом в 1 бит или 1 байт (8 бит ) ?

У процессора есть кэш, у компилятора задача оптимизировать код и его работу так чтобы все данные сидели в этом кэше и меньше была загрузка/выгрузка в озу. Из-за этого многопоточная программа будет сильно проигрывать однопоточной.
вся работа процессора настроена на работу с 8/16/32(x32) и в 64(x64) бита - это слово. Работа непосредственно с битами - это дополнительная арифметика(больше команд) - and/or/xor/shl/shr и др. То есть работать с битами процессору не выгодно - нужно дополнительно в asm детализировать бит.
Чтение в конвейер идет блоками за раз может кушать 64/8=8байт. Есть еще выравнивание.. кстати поэтому "type record .. end" <> "type packed record .. end". "record .. end" свои данные выравнивает по слову фактически "record a,b:byte end" - может занимать в памяти 16байт, а "packed record a,b:byte end" - 2 байта, но он будет тяжелее работать только из-за "промаха" при адресации процессора.
Об этом знают компиляторы - и формируют данные с выравниванием, иначе нужно указывать "packed". И "packed" будут не оптимизированные.
http://www.intuit.ru/studies/courses/60 ... ture/10327
https://ru.wikipedia.org/wiki/%D0%9A%D1 ... 1%80%D0%B0
Отсюда заполнение картинкой битами по 8 байт в row будет быстрее чем в colum.
olegy123
энтузиаст
 
Сообщения: 720
Зарегистрирован: 25.02.2016 12:10:20

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение Alex2013 » 27.10.2017 23:07:39

Это все теория ... (например понятно что сопроцессор FPU знает только экстендед тип (Extended - размер 10 байт, допускается 19 значащих цифр и диапазон экспоненты от 10**-4951 до 10**4931)) но на практике все не так однозначно ...

В данном случае реально существенно уменьшается объем данных (в 24 раза ) при обработке ...
Более того нужно прокачивать данные мне совершенно не нужные (у меня бинариизированное изображение нафига мне 24 бита вместо 1 одного ? ) Кроме того ускорение от использования особенностей архитектуры работает в основном с блочными операциями . А мне нужно "лопатить изображение по пикселю" ... + никто не отменял шаблоные операции сразу на несколько бит -пикселей ...
Заметил как я делаю инверсию? if x mod 8 =0 then Ba^[X div 8 ]:= not Ba^[X div 8 ] ; Один раз на байт .
В принципе если будет позволять размерность можно тоже самое делать и с LongWord и c Int64 ..
То есть при одном бите на пиксель реально обрабатывать по 64 пиксля за одну операцию !

Но проблема в том что часто мне нужно медленно и упорно копать по одному пикселю в бог ведет каком порядке и вот может оказаться что выгоднее собирать "по капле большой ложкой " чем прицельно капать в нужную лунку ....
Но это не как не касается совершено лишних двух байт в 24- битовом формате .
Это уже совсем уж "совковая лопата" выйдет !

А еще наверняка есть более оптимальный способ установки нужного бита .
Alex2013
энтузиаст
 
Сообщения: 697
Зарегистрирован: 03.04.2013 11:59:44

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение olegy123 » 28.10.2017 10:27:57

Я описал что компу проще работать со словами. Он заточен на это. А работа с битами это дополнительная арифметика.
Zub-у я приводил пример разрядности мантисы. Что в singl детализация числа это 6 цифр, хотя само число может быть лежать в 1,18x10^-38 до 3,4x10^38. То есть само число может лежать 1,18x10^-38 до 3,4x10^38 но точность только 6 знаков. Такая особенность работы компьютерной математики.

Alex2013 писал(а): А еще наверняка есть более оптимальный способ установки нужного бита .

Есть, но это уже будут частные решения.
я так понимаю - нужно найти границу перехода 1 на 0 и 0 на 1. Тогда проще смотреть на поля битов - если они не 0 и не $FF то ничего с ними не делать. если есть отличие $0/$FF значит есть переход, его анализировать. При заполнении картинки менее 75% такой подход начнет прирастать скоростью. По это есть MMX/SSE инструкции, которые за один проход могут обрабатывать группу байтов.
Если задача разбивается на груповой поиск - можно паралелить задачи. при 4х ядрах можно уменьшить поиск еще в 3.5 раза.
Нужно знать специфику компилятора - да же его тюнинг дополнительыми инструкциями может помочь подобрать правильные инструкции.

P/S теперь понятно почему многие игры кушают много ресурсов? А инные движки знают как выжить максимум полезных тактов проца.
olegy123
энтузиаст
 
Сообщения: 720
Зарегистрирован: 25.02.2016 12:10:20

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение Alex2013 » 28.10.2017 17:13:23

Добавил еще один тест (рекурсивный поиск контуров адаптированный для одного бита ).
ИзображениеИзображение
Вверху скрина тестируется инверсия (после правки пары глюков почти два прядка ускорения )
Поиск контуров как и ожидалось особо не ускорился но все-же что-то есть .

Зы
Но загадки поведения LCL при использовании онобитовых битмапов потратили немало нервов ...
1 После рекурсивной процедуры (догадываюсь что рекурсия не причем а все дело в кривой оптимизации )что-то портится в структуре битмапа и он перестает позволять вообще что-то делать собой с помощью методов LCL даже b2.Free вызывает исключение ...
2 не понятно нужны ли вообще b.BeginUpdate; и b.endUpdate; при одно-битовых битмапах .
(Но при частом циклическом использовании они довольно заметно кушают быстродействие )

Код: Выделить всё
// Тест поиска контуров ...
procedure TBTForm.Button4Click(Sender: TObject);
Var
myTime:TDateTime;
ts:String;
X,y:Integer;
Const
   RL:TList=nil;
    B:TBitmap=nil;
    B2:TBitmap=nil;

begin
if B1= nil then exit;
If RL=nil then RL:=TList.Create;
if B=nil  then B:=TBitmap.Create;
if B2=nil  then begin
B2:=TBitmap.Create;
B2.PixelFormat:=pf1bit;
b2.SetSize(b1.Width,b1.Height );
end;
B.Assign(image1.Picture.Bitmap);
Rl.Clear;
myTime:=now;

MyScanOBJECTS(RL ,b ,5,false );

str((now-myTime)*10e4:2:5,ts);
Label1.Caption:='Время 24 Bit: '+ts +' Контуров '+IntToStr(rl.count);

/ / Вместо b2.Canvas.Draw(0,0,b1);или b2.Assign(B1); иначе работает один раз 
For Y:=0 to B2.Width-1 do For X:=0 to b2.Height-1 do
ChangePixelState(b2,Y,X,GetPixelState(B1,X,Y ));
Rl.Clear;
b2.BeginUpdate;
myTime:=now;
MyScanOBJECTS1Bit(RL ,b2 ,5,false  )    ;
str((now-myTime)*10e4:2:5,ts);
Label2.Caption:='Время 1 Bit: '+ts +' Контуров '+IntToStr(rl.count);
b2.endUpdate;

// Убрал b2.Free; b2:=Nil; Выбивает !
end;


Доступ к пикселю для поиска контуров
Код: Выделить всё
// Доступ к одно битовым битмапам Чтение
function GetPixelState(Var B:TbitMap; x, y: integer): integer;
Type A=Array[0..1] Of byte; var  BA:^A;
begin
Ba:=b.ScanLine[y];
result:=(BA^[x div 8] shr (7-(x mod 8))) and 1;
end;

// Доступ к одно битовым битмапам Запись
procedure ChangePixelState(Var B:TbitMap; x, y, c: integer);
Type A=Array[0..1] Of byte; var  BA:^A;
begin
if GetPixelState(b,x,y)<>C then
begin
  Ba:=b.ScanLine[y];
  Ba^[x div 8]:= BA^[x div 8] xor (1 shl (7-(x mod 8)));
end;
end;

Alex2013
энтузиаст
 
Сообщения: 697
Зарегистрирован: 03.04.2013 11:59:44

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение zub » 28.10.2017 21:56:58

>>(догадываюсь что рекурсия не причем а все дело в кривой оптимизации
догадайся уже что занимаешся ерундой
zub
долгожитель
 
Сообщения: 2257
Зарегистрирован: 14.11.2005 23:51:26

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение Alex2013 » 29.10.2017 16:17:11

Браво ! Краткость сестра таланта ! :D
Но по теме что ? Передложи что-то более прогрессивное ..... Лень мучает ? Так и меня тоже причем постоянно .... :oops:

Новая версия Get_Pixel и Change_Pixel...
Код: Выделить всё
// Доступ к одно битовым битмапам Чтение
function Get_Pixel_State(Var B:TbitMap; x, y: integer): integer;
Type A=Array[0..1] Of byte;  PA=^A;
begin
result:=(PA(b.RawImage.Data)^[y*BytePerLine+x div 8]
                                      shr (7-(x mod 8))) and 1;
end;

// Доступ к одно битовым битмапам Запись
procedure Change_Pixel_State(Var B:TbitMap; x, y, c: integer);
var  BA:^byte;
begin
if Get_Pixel_State(b,x,y)<>C then
begin
  Ba:=Pointer(LongWord(b.RawImage.Data)+y*BytePerLine+x div 8);
  BA^:= BA^ xor (1 shl (7-(x mod 8)));
end;
end;


BytePerLine:=b.RawImage.Description.BitsPerLine div 8;
С ошибкой в битмапе видимо придется бороться "в рукопашную" то бишь сделать свой массив бит и работать с ним ...

Зы
А по философии все просто "Для того кто никуда не плывет никогда не бывает попутного ветра... " :idea:
Последний раз редактировалось Alex2013 29.10.2017 22:53:10, всего редактировалось 1 раз.
Alex2013
энтузиаст
 
Сообщения: 697
Зарегистрирован: 03.04.2013 11:59:44

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение zub » 29.10.2017 18:16:12

Ты реально думаешь что
>>(Способ вроде Ba^[X div 8 ]:=Ba^[X div 8 ] or (1 shr 7-(x mod 8 ) ) ; не выглядит особо оптимальным ....)
у тебя тормозит доступ какомуто конкредному биту-байту?

С какой целью begin\endUpdate внутри цикла?

Хочется поработать с растром на цпу - получил картинку в озу, обработал, оправил на обратно на видюху
zub
долгожитель
 
Сообщения: 2257
Зарегистрирован: 14.11.2005 23:51:26

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение Alex2013 » 29.10.2017 22:32:42

1 Не знаю ... но деление чуть убрал теперь так BA^:= BA^ xor (1 shl (7-(x mod 8 ))) ; интересно а можно ли x mod 8 заменить ? что то вроде Lo(x) and маска + из за xor приходится проверять if Get_Pixel_State(b,x,y)<>C ... по идее можно сделать
что-то вроде Tmp:= 7-(x mod 8 );BA^:= BA^ and (Not (1 shl TMP)); BA^:= BA^ or (C shl TMP); ... Или юзать множества ... :roll:

2 begin\endUpdate уже убрал ... Просто в случае с 24мя битами на пиксель разница была не особо незаметна .
Ну и принципе процедуру изменения цвета одного пикселя может потребоваться вызвать где-то отдельно так что по идее она должна работать как аналог массива Canvas.Pixels[]

3 Видюха как бы вообще "не приделах": тот же список конуров ищется полностью "в темную" и в тестовой программе я мог вообще одну "телеметрию" выводить .
Alex2013
энтузиаст
 
Сообщения: 697
Зарегистрирован: 03.04.2013 11:59:44

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение zub » 29.10.2017 23:55:15

(x mod 8 ) это (x and 7)
>>Просто в случае с 24мя битами на пиксель разница была не особо незаметна
если ты закоментируешь строчку с собственно манипуляцией битом разница думаю тоже не будет заметна. ты уж доведи свои тесты до конца и найди куда тратится время
zub
долгожитель
 
Сообщения: 2257
Зарегистрирован: 14.11.2005 23:51:26

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение olegy123 » 30.10.2017 13:51:30

Код: Выделить всё
{$inline on}
function getPixel(Data:Pointer;x,y,BytePerLine:interge):boolean; inline;
var
  addrPixel:PByte;
  offset:integer;
begin
  addrPixel:=Data+y*BytePerLine+x div 8;
  result:=((addrPixel^ shl (x and 7)) and $80)=$80;
end.


procedure setPixel(Data:Pointer;x,y,BytePerLine:interge;pixel:boolean); inline;
var
  addrPixel:PByte;
  offset:integer;
begin
  addrPixel:=Data+y*BytePerLine+x div 8;
  if (pixel) then
     addrPixel^:=addrPixel^ or ($80 shr (x and 7))
  else
     addrPixel^:=addrPixel^ and ($80 shr (x and 7) xor $ff);
end.

очень желательно чтобы команды были в asm-е с целочисленной(регистровой) арифметике..
olegy123
энтузиаст
 
Сообщения: 720
Зарегистрирован: 25.02.2016 12:10:20

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение Alex2013 » 31.10.2017 01:11:42

zub писал(а):(x mod 8 ) это (x and 7)
>>Просто в случае с 24мя битами на пиксель разница была не особо незаметна
если ты закоментируешь строчку с собственно манипуляцией битом разница думаю тоже не будет заметна. ты уж доведи свои тесты до конца и найди куда тратится время

Пробовал, вполне заметно получается ....
Вообще разумеется нужно сделать не рекурсивный поиск контуров ... это совершенно точно ОЧЕНЬ МЕДЛЕННЫЙ метод и проверить вариант с одним бйтом.
(То что 8-битовая арифметика может работать очень быстро сомнений нет никаких как пример у меня валяется "летающий" в фул-эйчди 3д -движок уровня "классического дума" )

olegy123 писал(а):
Код: Выделить всё
{$inline on}
function getPixel(Data:Pointer;x,y,BytePerLine:interge):boolean; inline;

очень желательно чтобы команды были в asm-е с целочисленной(регистровой) арифметике..

О спасибо ! Попробую ...
Alex2013
энтузиаст
 
Сообщения: 697
Зарегистрирован: 03.04.2013 11:59:44

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение zub » 31.10.2017 14:58:19

>>Пробовал, вполне заметно получается ....
А вместо многоточия привести код и циферки?

>> сомнений нет никаких как пример у меня валяется "летающий" в фул-эйчди
ну дак и используй его, нафиг тебе этот лцл сдался
zub
долгожитель
 
Сообщения: 2257
Зарегистрирован: 14.11.2005 23:51:26

Re: Ускорение работы с растровой графикой(Загадки одного би

Сообщение Alex2013 » 01.11.2017 17:41:59

zub писал(а):>>Пробовал, вполне заметно получается ....
А вместо многоточия привести код и циферки?

Смысла нет около нуля тысячных секунды получается (просто без "операции над байтами " рекурсия не раскрывается два пустых цикла ... чем смысл их мерить? )

>> сомнений нет никаких как пример у меня валяется "летающий" в фул-эйчди
ну дак и используй его, нафиг тебе этот лцл сдался

LCL уже сейчас идет лесом ... От него окна да кнопки остались .
Дык зачем мне чужой ТриДи движок для работы видео потоком ?
Зы
Кстати есть еще один "2.5D" движок (с исходниками на дельфи) и попроще, я его в лазрус сконвертировл, работает.
( одна проблема палитру настроить не выходит. )
Alex2013
энтузиаст
 
Сообщения: 697
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex [Bot] и гости: 5

Рейтинг@Mail.ru