Интересное решение поиска области

[ImmortalAlexSan]

Что-то сам не могу разобраться, прошу помощи. Хочу организовать пересчет единичек в матрице, размерностью 20х20. Например:
0001111100
0001001100
0000011000
0000110000
0001111100
Принцип расположение '1' следующий: каждая единица имеет как минимум соседнюю единицу, которая находится в клетке рядом. (на рисунке изображена цифра "2". Я не хочу идти простым путем перебора строк и столбцов сверху вниз и слева направо и записывать координаты единичек. У меня есть более интересное решение, которое, может быть придумали и до меня (я не искал). заключается оно в следующем: найти первую единицу слева сверху и далее организовать два потока, которые будут перебирать вправо и вниз по пути находя единицы, вычисляя рядом стоящих соседей (0 или 1, чтобы узнать есть смысл создавать еще потоки или нет и есть ли смысл закрывать порождающий поток или нет). Это все можно организовать вложенными циклами (я так делал, но это некрасиво). Если сравнивать алгоритм, то можно провести параллель с игрой (или как там её) "Жизнь", где каждая частица порождает себе подобную. Набросал здесь пару строчек кода, но возникают проблемы с передачей параметров в поток и хотелось бы узнать, как сделать так чтобы поток порождал поток? Динамические массивы beginthread не понимает, а одну и туже переменную использовать нельзя. Поделитесь идеями по реализации. Если через потоки - муть, то так и ответьте, предложите что-нибудь получше.

type
  TCords=record
  i,j:integer;
end;

var
  Form1: TForm1;
  BlackPix:byte;
  ThreadID,ThreadID2:Cardinal;
  HThread,HThread2:THandle;

procedure TForm1.Button1Click(Sender: TObject);
begin
BlackPix:=0;
HThread:=BeginThread(nil,0,@execute,nil,0,ThreadID);
end;

ThreadVar
Cords:^TCords;


procedure execute(Parametr:Pointer);
Var
i,j:integer;
begin
If parametr<>nil then
begin
Cords:=Parametr;
i:=Cords.i;
j:=Cords.j;
end
else
j:=1;
For i:=1 to 19 do
If Form1.StringGrid1.Cells[i,j]='1' then
begin
inc(BlackPix);
Cords.i:=i;
Cords.j:=j;
HThread2:=BeginThread(nil,0,@execute,@Cords,0,ThreadID2);
end;
Showmessage(inttostr(BlackPix));
end;

С кодом косяк, пока не могу собрать воедино весь алгоритм, ибо запутался я.

[spamer]

Дык, а если не секрет, к чему такие заморочки ?

[ImmortalAlexSan]

spamer, так а в чем собственно заморочки? Хороший программер влет это сделает. Ну а вообще при поиске маленьких областей это должно сыкономить массу времени.

[Virtson]

Сообщение от ImmortalAlexSan

С кодом косяк, пока не могу собрать воедино весь алгоритм, ибо запутался я.

Не мудрено, что запутались.

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

Если 4-связность, то проверять тот же индекс j, что у рассматриваемой ячейки.
Если 8-связность, то j, j-1, j+1.

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

[eoln]

Я через рекурсию подобное делал. Что-то вроде этого. Это для таблицы 5х5. StringGrid1 - исходная, StringGrid2 - результат

procedure TForm1.Button1Click(Sender: TObject);
procedure MakeList(x, y: byte);
begin
  if stringgrid1.Cells[x, y] = '0' then exit;
  StringGrid1.cells[x, y] := '0';
  StringGrid2.cells[x, y] := '*';
  if (x > 0) then MakeList(x - 1, y);
  if (x < 5) then MakeList(x + 1, y);
  if (y > 0) then MakeList(x, y - 1);
  if (y < 5) then MakeList(x, y + 1)
end;
begin
  MakeList(2, 0)//позиция первой единички
end;

[ImmortalAlexSan]

Спасибо за ответы, буду думать. За выходные найду выход наверное. А так моя идея с организацией потоков - основная, но я её немного переиначил, так как первоначальный вариант был глупым и тупиковым... Дам знать в этой теме, как закончу с этой частью работы.

[Virtson]

Да, использование рекурсии удобно в плане кодирования, но скорость обработки дает похуже.
ImmortalAlexSan, потоки в задаче такой размерности не нужны. Используйте динамические структуры для хранения вершин 'потоков', которые разделяются.

Если бы стояла задача использования параллельных вычислений, проще разделить всю область на участки без пересечений и обрабатывать параллельно. Иначе передача данных м.у потоками убивает весь выигрыш в производительности.
Также советую погуглить про CUDA технологию и использование GPU в целом.

[ImmortalAlexSan]

Так вот, продолжая тему! Времени на программирование остается только на вечер, так как работа берет свое... Но, несмотря на это, я все-таки нашел способ выделения сплошной области. Для графики называется он: выделение с затравочным пикселем, или что-то в этом духе Подробнее можно почитать тут! http://skyfamily.ru/sprav/string/algoritm/ и тут! http://www.intuit.ru/department/grap...html#image.6.8 и много где! Но вот поиск по интернету не дал мне результатов в виде кода на дельфи, а хотелось бы! Может кому-то тоже хочется так я и поделюсь своим, правда он громоздок и не оптимизирован! Если хотите займитесь сами, а мне пока некогда, когда программа готова будет, займусь сам

//Описываем тип для использования в стеке TObjectStack
type
  TCord=integer;
  TPospixel=class
  private
  fX,fY:TCord;
  Constructor Create(ax,ay:TCord);
  procedure RemakePixXY(ax,ay:TCord);
  Function GetfY(ay:TCord):TCord;
  Function GetfX(ax:TCord):TCord;
end;

...

Constructor TPospixel.Create(ax,ay:TCord);
begin
fX:=ax;
fY:=ay;
end;

procedure ReBinarBMP(bmp:TBitmap);
Var
  i,j,x,y,xl,xr:integer;
  BlackBegin:boolean;
  flag:byte;
  Stack:TObjectStack;
  CordsXY,ps:TPospixel;
begin
Stack:=TObjectStack.create;
bmp.PixelFormat:=pf24bit;
i:=0;
j:=1;
BlackBegin:=false;
Repeat
inc(i);
If Form1.Image2.Canvas.Pixels[i,j]=clBlack then
  begin
  BlackBegin:=true;
  x:=i;
  y:=j;
  end;
If i=bmp.Width then
  begin
  inc(j);
  i:=0;
  end
Until BlackBegin=true;
i:=0;j:=0;
CordsXY:=TPospixel.Create(x,y);
Stack.Push(TPospixel.Create(x,y));
While Stack.Count>0 do
  begin
  ps:=Stack.Pop as TPospixel;
  xl:=ps.fX-1;
  While Form1.Image2.Canvas.Pixels[xl,y]=clBlack do
    begin
    xl:=xl-1;
    If xl>Form1.Image2.Picture.Bitmap.Width then
      begin
      xl:=xl+1;
      break;
      end;
    end;
  xr:=ps.fx+1;
  While Form1.Image2.Canvas.Pixels[xr,y]=clBlack do
    begin
    inc(xr);
    If xr>Form1.Image2.Picture.Bitmap.Width then
      begin
      xr:=xr-1;
      break;
      end;
    end;
  For j:=xl to xr do
  Form1.Image2.Canvas.Pixels[j,ps.fy]:=clWhite;
flag:=1;
For x:=xl to xr do
begin
ps.fx:=x;
If Form1.Image2.Canvas.Pixels[ps.fx,ps.fy-1]=clBlack then
  If flag=1 then
  begin
  Stack.Push(TPospixel.Create(ps.fx,ps.fy-1));
  flag:=0;
  end
else
flag:=1;
end;
flag:=1;
For x:=xl to xr do
begin
ps.fx:=x;
If Form1.Image2.Canvas.Pixels[ps.fx,ps.fy+1]=clBlack then
  If flag=1 then
  begin
  Stack.Push(TPospixel.Create(ps.fx,ps.fy+1));
  flag:=0;
  end
else
flag:=1;
end;
end;
Stack.Free;
end;

В данном случае код был написан для поиска однородной непрерывной области черного цвета на изображении, но его можно переделать и для двумерного массива! Периодически буду обновлять тему, если найду ещё пути решения или модернизирую этот!