Поиск контура без рекурсии

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

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

Поиск контура без рекурсии

Сообщение Alex2013 » 11.09.2017 17:59:31

Вообщем решил я писать свой собственный метод писка контуров(после бинаризации ) причем без рекурсии ...
В первом приближении получилось нечто изрядно корявое ..
(Пока обедал понял что у меня "логическая яма" образовалась и нет обработки нескольких ситуаций с пространственным расположением нескольких контуров )
Но тем не менее идея "проста как двери" ! :idea:
Обходим найденный пиксель по квадрату и увеличиваем квадрат пока в нем есть точки ...

Но может кто-то видел готовую функцию ?

Зы
Текущая недоделка ...

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

Function MyScanOBJ(Var image:tBitmap;x,y:Longint):trect;
Var
W,H:Longint;
I,J:Longint;
XN,YN,XK,YK:Longint;
FE:Boolean ;
begin
W:=image.Width;
H:=image.Height;
Result.Left:=X;
Result.Right:=X;

Result.Top:=Y;
Result.Bottom:=Y;

XN:=X;YN:=Y;
XK:=X;YK:=Y;
Set_Pixel(Image,X,Y, clRed);

Repeat
XN:=XN-1;
YN:=YN-1;

XK:=XK+1;
YK:=YK+1;
FE:=False;

For I:=XN to XK Do
if (i in [0..W-1]) then
begin
if (YN in [0..H-1]) then
if (get_Pixel(Image,I,YN)= clBlack) then
begin
  Set_Pixel(Image,I,YN, clRed);
  FE:=True;
  Result.Top:=YN;
End;

if (YK in [0..H-1]) then
if (Get_Pixel(Image,I,YK)= clBlack) then
begin
Set_Pixel(Image,I,YK, clRed);
FE:=True;
Result.Bottom:=YK;
End;
end;

For J:=YN to YK Do
if I in [0..H-1] then
begin
if XN in [0..W-1] then
if (Get_Pixel(Image,XN,J)= clBlack) then
begin
  Set_Pixel(Image,Xn,J, clRed);
  FE:=True;
  Result.Left:=XN;
End;
if (XK in [0..W-1]) then
  if (Get_Pixel(Image,XK,J)= clBlack) then
begin
Set_Pixel(Image,XK,J, clRed);
  FE:=True;
  Result.Right:=XK;
   End
  end;
until Not Fe;
end;
// Массовый поиск и запоминание границ
procedure MyScanOBJECTS(Var RL:TList; Var image:tBitmap;x,y,DR:Longint);
Var
  W,H:Longint;
  R:^Trect;
  Lf:Boolean;
begin
If image=nil then exit; // !! Тут была наглая опечатка ... :))
Lf:=False;
Repeat
   Lf:=False;
   W:=image.Width-1;
   H:=image.Height-1;
   For Y:=0 to W do
   For X:=0 to H do
   begin

    if  Get_Pixel(image,x,y)=clBlack  then begin
      GetMem(R,SizeOf(Trect));
      R^:=MyScanOBJ(image,x,y );
     // Проверка длинны "косой сажени" то бишь диагонали     
      if Sqrt(Sqr(ABS(r.Bottom-R.Top))+Sqr(ABS(R.Right-r.Left)))>DR then
        begin
          RL.Add(R) ;
          LF:=True;
        end  else FreeMem(R,SizeOf(Trect));
       end
      end;

   Until not LF;

  end;

Последний раз редактировалось Alex2013 12.09.2017 15:39:09, всего редактировалось 1 раз.
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44

Re: Поиск контура без рекурсии

Сообщение runewalsh » 11.09.2017 18:22:33

A in [B .. C] — проверка на вхождение в множество (set of), т. о. ввиду их специфики в паскале B и C должны быть от 0 до 255, на 256+ вылетит рейнджчек, если включен. В крайнем случае сделай себе function InRange(x, a, b: integer): boolean; begin result := (x >= a) and (x < b); end;.

Остальное не читал, тебе, скорее всего, нужен алгоритм заливки.
Аватара пользователя
runewalsh
энтузиаст
 
Сообщения: 578
Зарегистрирован: 27.04.2010 00:15:25

Re: Поиск контура без рекурсии

Сообщение vitaly_l » 11.09.2017 18:39:24

runewalsh писал(а):тебе, скорее всего, нужен алгоритм заливки.

Алгоритм жука = контур.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Поиск контура без рекурсии

Сообщение Alex2013 » 11.09.2017 18:56:42

runewalsh писал(а):A in [B .. C] — проверка на вхождение в множество (set of), т. о. ввиду их специфики в паскале B и C должны быть от 0 до 255, на 256+ вылетит рейнджчек, если включен. В крайнем случае сделай себе function InRange(x, a, b: integer): boolean; begin result := (x >= a) and (x < b); end;.


О отличный совет ! Спасибо ! :idea:
Возможно в этом причина недообработки данных (Вроде не вылетает но вполне возможно что не работает ) ... Хотя вроде через множества всюду сделана стандартная проверка двухбайтовых кодов клавиатуры ... :roll: но попробую !
:idea:
Остальное не читал, тебе, скорее всего, нужен алгоритм заливки.

Как пример ? Гм ... это мысль ....
Но рекурсивный "жук" у меня и так есть (А закраска идет просто чтобы отметить обработанный контур и не обрабатывать его повторно )
Был кода-то еще и обход по периметру но там такие глюки были что я взял более медленный но более надежный алгоритм с закраской .
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44

Re: Поиск контура без рекурсии

Сообщение Vlad04 » 12.09.2017 16:03:46

Параметр DR у Вас используется только для сравнения. Один раз возведите его в квадрат и откажитесь от извлечения квадратного корня, он у вас в тройном цикле.
А если монохромная область не прямоугольная?
Аватара пользователя
Vlad04
новенький
 
Сообщения: 78
Зарегистрирован: 11.12.2007 21:11:19
Откуда: Караганда. Казахстан

Re: Поиск контура без рекурсии

Сообщение Alex2013 » 12.09.2017 16:20:25

Вот сижу и думаю как разбить эту операцию (неважно как она будет реализована) на несколько потоков ...
Раз уж вообще сделал отдельный поток ....

Код: Выделить всё
// Поток для поиска контуров
Type
    TRRThread = class(TThread)
  private
  protected
    procedure Execute; override;
    procedure ShowStatus;
    procedure Ex_Sobj;
  public
    LF:Boolean;
    XX,YY: Integer;
    MsG:String;
    RR:Trect;
    constructor Create(CreateSuspended: boolean);
  end;

procedure TRRThread .ShowStatus;
// this method is only called by Synchronize(@ShowStatus) and therefore
// executed by the main thread
// The main thread can access GUI elements, for example Form1.Caption.
begin
CO_Form.Label2.Caption:=Msg;
end;
procedure TRRThread.Ex_Sobj;
begin
if CO_Form.CheckBox23.Checked then
RR:=myScanOBJ(CO_Form.BRR,XX,YY )
else RR:=ScanOBJ(CO_Form.BRR,XX,YY );

end;

procedure TRRThread.Execute;
Var
  W,H,X,Y,C,Co:Longint;
  R:^Trect;
  Label LL;

begin
while (not Terminated) and (true {any condition required}) do begin

   If CO_Form.BRR<>nil then Begin
   Lf:=False;
   CO_Form.F_W_RR:=True;
   W:=CO_Form.BRR.Width-1;
   H:=CO_Form.brr.Height-1;
   Msg:=IntToStr(X)+':'+IntToStr(Y)+':'+ IntToStr(CO_Form.RRL.Count);
   For Y:=0 to W do Begin
   For X:=0 to H do
   begin

   If CO_Form.BRR=nil then goto LL;
    C:=  Get_Pixel(CO_Form.BRR,x,y);
    if C=clBlack  then begin
      GetMem(R,SizeOf(Trect));
      XX:=X;YY:=Y;
      Synchronize(Ex_Sobj);// Думал: вдруг будет лучше ?  Хотя не факт, что не стало стабильнее ...
        // но  возможно теряется весь выигрыш скорости от многоядерной архитектуры
       //  хотя пока поток сделан не для успокоения, а из за возможности наблюдать  процесс ...
      R^:=RR;
      ///    R^:=MyScanOBJ(CO_Form.BRR,x,y );
      CO_Form.F_W_RR:=False;
      if Sqrt(Sqr(ABS(r.Bottom-R.Top))+Sqr(ABS(R.Right-r.Left)))>3 then
        begin
         CO_Form.RRL.Add(R) ;
         Msg:=IntToStr(X)+':'+IntToStr(Y)+':'
              + IntToStr(CO_Form.RRL.Count);
         Synchronize(ShowStatus);
         LF:=True;
        end  else FreeMem(R,SizeOf(Trect));
       end
      end
     end;

    If not LF Then
     begin
       MSG:='OK';
       Synchronize(ShowStatus);
       CO_Form.BRR.Free;
       CO_Form.Brr:=Nil;
     end;

   LL:CO_Form.F_W_RR:=False;
    end
   end
  end;

constructor TRRThread.Create(CreateSuspended: boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

Вот такая фича ...
И так как сделать разбивку задачи на несколько потоков ? Разумеется можно просто разделить битмап на несколько полос но потом нужно будет как-то собирать разорванные контуры ... В голове крутятся идеи начать поиск первой точки из разных углов ... И довести дело окурат до середины . НО как отслеживать встречное пресечения контуров обнаруженных с разных сторон ? Да и повторы будут ...
Единственное что приходит в голову это размножить битмап по потокам . (От пресечения не спасет но будет надежнее)

Что посоветуете ?
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44

Re: Поиск контура без рекурсии

Сообщение olegy123 » 12.09.2017 21:08:29

Количество потоков как правило ограниченно ядрышками процессора.

Открой учебник CUDA или OpenCL = они нацелены решать подобные задачи.
Я не понимаю что такое "встречное пресечения контуров".
Но если задача разбивается на участки, которые в последствии имеют такой же сегментированый результат [входные данные] =>[ [Результат][Результат][Результат][Результат][Результат]].
легко решаются CUDA и OpenCL, их можно разделить на много потоков.

Но если [входные данные] =>[ ~ Р ~ е ~ з ~ у ~ л ~ ь ~ т ~ а ~ т ~ ] то лучше решать большим проциком.

Добавлено спустя 2 минуты 58 секунд:
например изменение цвета, цветокоррекция. на CUDA/OpenCL делается быстро..
но Blur для CUDA/OpenCL уже гиперзатратная операция.
olegy123
долгожитель
 
Сообщения: 1643
Зарегистрирован: 25.02.2016 12:10:20

Re: Поиск контура без рекурсии

Сообщение Alex2013 » 13.09.2017 01:04:03

Я не понимаю что такое "встречное пресечения контуров".

Просто представь для наглядности ситуацию типа "Японский флаг"
(То бишь один большой заполнений круг по центру ... )
Начинаю искать точки сверху и снизу ... Опа нашили! Одновременно...
Что будет если поток который ищет границу сверху столкнется с тем что ищет снизу ?
Там же просто как-бы заполнение левым цветом идет... (оно типа лишнее для задачи, но как найденные точки отмечать ? )
Вот и представь, что это два маляра красят стену дома одновременно с верху и снизу .
КУ? Суть в том, что я могу остановить поиск начальной точки но не сам процесс рекурсивного (или не очень) поиска границ ...
Отсюда идея подсунуть каждому "маляру " (процессу ) "Свою стену" но опять же могут быть копии контуров найденных сверху и снизу ... Нужно отслеживать повторы ... но кроме того будут потери времени на лишний поиск .

Так что наверное лучше разобрать "стену" на "панели-полосы" и озаботится простым алгоритмом обеднения "пограничных территорий " в "единые анклавы" . :idea:

Зы
1 CUDA вообще из другой оперы это расчеты с помощью GPU видео карты (в основном от Nvideo которых у меня вообще нет )...
2 Процессов может быть сколько угодно (Моя программа тому пример, только у меня они таймером эмулируются,однако в каждом окне + разные превью идет смена кадров "в условно реальном времени " ... Но можно было тоже самое и с помощью потоков сделать.
3 "Нативные" процессы имеют системную и (если есть несколько ядер или CPU) аппаратную поддержку но с точки зрения прикладной программы то сервиса предоставляемого таймером отличаются мало .
4 Раскидать блур по ядрам это как раз самое простое ! :arrow: http://freepascal.ru/forum/viewtopic.ph ... 32#p125032
Последний раз редактировалось Alex2013 18.09.2017 00:10:06, всего редактировалось 1 раз.
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44

Re: Поиск контура без рекурсии

Сообщение olegy123 » 13.09.2017 01:43:03

Alex2013 писал(а):Так что наверное лучше разбросать "стену" на "панели-послы" и озаботится простым алгоритмом обеднения "пограничных территорий " в "единые анклавы" .

именно так оно и делается - каждому процессу или (ALU https://ru.wikipedia.org/wiki/%D0%90%D1 ... 0%B2%D0%BE) дается свой участок, который обрабатывается.
На выходе получишь некий массив.. допустим есть RGB пространство -> переводим в битовое пространство, где [0,1]. 1-есть переходы, 0 ничего. Далее нужно анализировать фигуру, на замкнутость

Добавлено спустя 4 минуты 32 секунды:
http://www.inf.tsu.ru/library/DiplomaWo ... diplom.pdf
olegy123
долгожитель
 
Сообщения: 1643
Зарегистрирован: 25.02.2016 12:10:20

Re: Поиск контура без рекурсии

Сообщение Alex2013 » 14.09.2017 17:01:49

runewalsh писал(а):A in [B .. C] — проверка на вхождение в множество (set of), т. о. ввиду их специфики в паскале B и C должны быть от 0 до 255, на 256+ вылетит рейнджчек, если включен. В крайнем случае сделай себе function InRange(x, a, b: integer): boolean; begin result := (x >= a) and (x < b); end;.


Еще раз спасибо ! Как только вы чистил все "не печатные выражения " в стиле "A in [B .. C]" (А их у меня раскидано по коду оказалось немало ) все заработало как надо. ну почти ... :wink: бо багов видимо у меня кроме этого еще не мал .... :roll:
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44

Re: Поиск контура без рекурсии

Сообщение vada » 14.09.2017 17:31:59

Я интересуюсь, а чего такая нелюбоФь к рекурсии? В детстве стек переполнился?
Аватара пользователя
vada
энтузиаст
 
Сообщения: 691
Зарегистрирован: 14.02.2006 13:43:17

Re: Поиск контура без рекурсии

Сообщение Alex2013 » 14.09.2017 20:47:31

vada писал(а):Я интересуюсь, а чего такая нелюбоФь к рекурсии? В детстве стек переполнился?

Да ни чего я не имею против рекурсии... случае если её глубина заранее предсказуема и гарантированно укладывается в разумные рамки .
+ есть такая ну очень оригинальная среда разработки ХайАсм .. ага ! Там не то что бы всюду рекурсия была но ... что-то к ней очень близкое ...
Ведь там почти нет "горизонтального " кода и все построено на цепочках вызовов и лютый Ужос этой среды называется "кольцевание" (рассказывать этот "цифровой харрор" можно долго, но поверьте, это нечто вроде "черной магии " от программирования... Медвежуть ! 8) ) так что мой опыт не дает относится к неконтролируемому рекурсивному процессору слишком спокойно ...

Да и в предыдущем проекте акурат с этой же процедурой уже "все было" то бишь " внезапный конец стека" (Правда там был скрипт ...)
И разумеется первое о чем я подумал увидев свежий баг это сбой рекурсии .
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44

Re: Поиск контура без рекурсии

Сообщение vada » 15.09.2017 15:50:46

Так и знал. Детские страхи :)
А еще многопоточность в рекурсию загнать!!!! Вот оно!

Ладно. Шучу. Тема конечно очень интересная.
Аватара пользователя
vada
энтузиаст
 
Сообщения: 691
Зарегистрирован: 14.02.2006 13:43:17

Re: Поиск контура без рекурсии

Сообщение Alex2013 » 17.09.2017 23:49:42

vada писал(а):Так и знал. Детские страхи :)
А еще многопоточность в рекурсию загнать!!!! Вот оно!

Дык ! УЖЕ ! (Поток течет на запад ... да утонет он в море ночи ! ) :D
Ладно. Шучу. Тема конечно очень интересная.



Кстати, чтобы не начинать новою тему...
Добрался я до более менее стабильного распознавания метки и на повестке дня вопрос :
Что делать дальше ?
1 Можно улучшить распознавание "в лоб" (также как я добавил вращение ) добавив афинные преобразования
2 Можно вообще сменить метод на учитывающий поворот и проективные искажения
3 Можно уйти в дебри и поискать счастье в неросетях ...

Но мне вообще-то нужно непросто распознать метку, а узнать её положение в трехмерном пространстве :idea:
(не слишком оторвавшись как по времени обработки так и по времени разработки бо скоро надо будет заняться более прагматичными проектами )

Так что, народ, что посетуете ? :idea:
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

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

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

Рейтинг@Mail.ru