Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 31
Написал небольшой алгоритм, может кому-то пригодится, работает шустро.
Программа, с примером
-------------------------------------------------------------

Красным помечены значения которые нужно вводить.
Синим помечены значения на выходе.

w := 100; // Количество ячеек в таблице по горизонтали
h := 100; // Количество ячеек в таблице по вертикали
 setlength(NumByXY,0,0);               
 setlength(NumByXY,w,h); 
 setlength(Nxy,0,0);                            
 setlength(Nxy,w*h,2);
 CikleStep := 0; // Порядковый номер выполненного цикла
 for Y1 := 0 to h-1 do
 begin
  for X1 := 0 to w-1 do
  if NumByXY[X1,Y1]=0 then // Если число не было помечено
  begin
   CikleStep := CikleStep+1; // Порядковый номер выполненного цикла
   Nxy[0,0] := X1; // Начальная координата X 
   Nxy[0,1] := Y1; // Начальная координата Y
   Step1 := 0; // Номер действия

NewNum := NumInTable[Nxy[0,0],Nxy[0,1]]; // Число для сравнения из ячейки по координатам "Nxy[0,0], Nxy[0,1]"
   Repeat // НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ, СО ЗНАЧЕНИЯМИ "NewNum"
    Nx := Nxy[Step1,0]; // Копируем координату X
    Ny := Nxy[Step1,1]; // Копируем координату Y
    Step1 := Step1-1;
    for h1 := 0 to 2 do
    begin
     h2 := h1-1;
     Ny1 := Ny-h2;
     if (Ny1>-1) and (Ny1<h) then
     for w1 := 0 to 2 do
     begin
      w2 := w1-1;
      Nx1 := Nx-w2;
      if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
      begin

if (NumInTable[Nx1,Ny1]=NewNum) // Если числа совпадают и ячейка "Nx1,Ny1" не была помечена
          and (NumByXY[Nx1,Ny1]=0)
       then
       begin
        Step1 := Step1+1;
        Nxy[Step1,0] := Nx1; // ЗНАЧЕНИЕ КООРДИНАТЫ "X"
        Nxy[Step1,1] := Ny1; // ЗНАЧЕНИЕ КООРДИНАТЫ "Y"

NumByXY[Nx1,Ny1] := CikleStep; // Номер детали в ячейке "Nx1, Ny1" (Координата помечена – отсчет деталей от 1)
       end;
      end;
     end;
    end;
   Until Step1<0;
  end;
 end;


// Глобальные переменные:
NumByXY : array of array of integer;
// Локальные переменные:
X1,Y1,w,h,w1,h1,w2,h2,Nx,Ny,Nx1,Ny1,NewNum,Step1,CikleStep : integer;
Nxy : array of array of integer;


К сообщению приложен файл. Размер - 121Kb
5 мар 19, 16:22    [21825544]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Arioch
Member

Откуда:
Сообщений: 10598
Ученик_333
Написал небольшой алгоритм


алгоритм заливки области картинки одним цветом (flood fill)

есть почти во всех 2D графических библиотеках

и в классических книгах, например http://sulfurzona.com/?art=201
Р. Джордейн. «Справочник программиста персональных компьютеров типа IBM PC, XT и AT»
5 мар 19, 16:30    [21825563]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Arioch
Member

Откуда:
Сообщений: 10598
Xonix что ли пишешь ?
5 мар 19, 16:31    [21825566]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 31
Arioch
алгоритм заливки области картинки одним цветом (flood fill)

Ну вот, точно. Старая-добрая заливка, не додумался.. Спасибо)
5 мар 19, 19:11    [21825698]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Arioch
Member

Откуда:
Сообщений: 10598
Ученик_333,

ты ж, глaвное, на рисунке же сам её нарисовал
5 мар 19, 19:51    [21825729]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 31
Arioch,

Простая невнимательность)
6 мар 19, 07:31    [21825887]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
982183
Member

Откуда: VL
Сообщений: 2619
Если хочешь поработать.
Заполни таблицу нулями и единичками.
А потом найди кратчайший путь с произвольной точки до границы массива
по одинаково заполненным ячейкам.
6 мар 19, 07:44    [21825890]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 31
Интересное предложение, надо подумать...
6 мар 19, 15:00    [21826377]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Arioch
Member

Откуда:
Сообщений: 10598
982183,

а оптимизировать по скорости надо?

если нет - то задача примитивная

напоминает одну мелко-олимпиадную: в лабиринт (клетчатое поле с наримованными где-то препятствиями) выпускают робота, у робота никаких глаз нету, он лабиринта не видит и ничего о нём не знает, где его выпустили - тоже. Но ему дают какой-то гарантированно выводящий наружу путь (типа шаг вверх, шаг вправо, шаг влево). Нужно построить наикратчайший гарантированного выводящий наружу.
6 мар 19, 20:43    [21826754]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 31
Исправил пару ошибок.
Программа, с примером
+ НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ В ТАБЛИЦЕ
Красным помечены значения которые нужно вводить.
Синим помечены значения на выходе.

w := 100; // Количество ячеек в таблице по горизонтали
h := 100; // Количество ячеек в таблице по вертикали
setlength(NumByXY,0,0);
setlength(NumByXY,w,h);
setlength(Nxy,0,0);
setlength(Nxy,w*h,2);
CikleStep := 0; // Порядковый номер выполненного цикла
for Y1 := 0 to h-1 do
begin
for X1 := 0 to w-1 do
if NumByXY[X1,Y1]=0 then // Если число не было помечено
begin
CikleStep := CikleStep+1; // Порядковый номер выполненного цикла
Nxy[0,0] := X1; // Начальная координата X
Nxy[0,1] := Y1; // Начальная координата Y
Step1 := 0; // Номер действия
NewNum := NumInTable[Nxy[0,0],Nxy[0,1]]; // Число для сравнения из ячейки по координатам "Nxy[0,0], Nxy[0,1]"
NumByXY[X1,Y1] := CikleStep; // Номер детали в ячейке "X1, Y1" (Координата помечена – отсчет деталей от 1)
Repeat // НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ, СО ЗНАЧЕНИЯМИ "NewNum"
Nx := Nxy[Step1,0]; // Копируем координату X
Ny := Nxy[Step1,1]; // Копируем координату Y
Step1 := Step1-1;
for h1 := 0 to 2 do
begin
h2 := h1-1;
Ny1 := Ny+h2;
if (Ny1>-1) and (Ny1<h) then
for w1 := 0 to 2 do
begin
w2 := w1-1;
Nx1 := Nx+w2;
if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
begin
if (NumInTable[Nx1,Ny1]=NewNum) // Если числа совпадают и ячейка "Nx1,Ny1" не была помечена
and (NumByXY[Nx1,Ny1]=0)
then
begin
Step1 := Step1+1;
Nxy[Step1,0] := Nx1; // ЗНАЧЕНИЕ КООРДИНАТЫ "X"
Nxy[Step1,1] := Ny1; // ЗНАЧЕНИЕ КООРДИНАТЫ "Y"
NumByXY[Nx1,Ny1] := CikleStep; // Номер детали в ячейке "Nx1, Ny1" (Координата помечена – отсчет деталей от 1)
end;
end;
end;
end;
Until Step1<0;
end;
end;

// Глобальные переменные:
NumByXY : array of array of integer;
// Локальные переменные:
X1,Y1,w,h,w1,h1,w2,h2,Nx,Ny,Nx1,Ny1,NewNum,Step1,CikleStep : integer;
Nxy : array of array of integer;

Добавил возможность в процессе поиска смежных ячеек, определять их соотношения (в виде углов) к ближайшим смежным ячейкам.
Программа, с примером
+ НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ В ТАБЛИЦЕ + Углы
Красным помечены значения которые нужно вводить.
Синим помечены значения на выходе.

w := 100; // Количество ячеек в таблице по горизонтали
h := 100; // Количество ячеек в таблице по вертикали
setlength(NumByXY,0,0); setlength(NumByXY,w,h);
setlength(Nxy,0,0); setlength(Nxy,w*h,2);
setlength(DegreeByXY,0,0,0,0); setlength(DegreeByXY,w,h,4,2);
setlength(PosDegree,0); setlength(PosDegree,8);
CikleStep := 0; // Порядковый номер выполненного цикла
for Y1 := 0 to h-1 do
begin
for X1 := 0 to w-1 do
if NumByXY[X1,Y1]=0 then // Если число не было помечено
begin
CikleStep := CikleStep+1; // Порядковый номер выполненного цикла
Nxy[0,0] := X1; // Начальная координата X
Nxy[0,1] := Y1; // Начальная координата Y
Step1 := 0; // Номер действия
NewNum := NumInTable[Nxy[0,0],Nxy[0,1]]; // Число для сравнения из ячейки по координатам "Nxy[0,0], Nxy[0,1]"
NumByXY[X1,Y1] := CikleStep; // Номер детали в ячейке "X1, Y1" (Координата помечена – отсчет деталей от 1)
Repeat // НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ, СО ЗНАЧЕНИЯМИ "NewNum"
Nx := Nxy[Step1,0]; // Копируем координату X
Ny := Nxy[Step1,1]; // Копируем координату Y
Step1 := Step1-1;
for StepDegree1 := 0 to 7 do PosDegree[StepDegree1] := 0; // Обновление массива
for h1 := 0 to 2 do
begin
h2 := h1-1;
Ny1 := Ny+h2;
if (Ny1>-1) and (Ny1<h) then
for w1 := 0 to 2 do
begin
w2 := w1-1;
Nx1 := Nx+w2;
if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
begin
if NumInTable[Nx1,Ny1]=NewNum then // Если числа совпадают
begin
if NumByXY[Nx1,Ny1]=0 then // Если ячейка "Nx1,Ny1" не была помечена
begin
Step1 := Step1+1;
Nxy[Step1,0] := Nx1; // ЗНАЧЕНИЕ КООРДИНАТЫ "X"
Nxy[Step1,1] := Ny1; // ЗНАЧЕНИЕ КООРДИНАТЫ "Y"
NumByXY[Nx1,Ny1] := CikleStep; // Номер детали в ячейке "Nx1, Ny1" (Координата помечена – отсчет деталей от 1)
end;
if h1=0 then NCell1 := w1 else
if h1=1 then NCell1 := 2*(2-w1)+3 else
if h1=2 then NCell1 := 2*(2-w1)+3+w2; // Порядковый номер позиции вокруг ячейки, от 0 до 7
if NCell1>3 then NCell1 := 11-NCell1 else
NCell1 := 3-NCell1; //Выровнять позиции под угловую систему координат (180=лево, 0=право, 90=верх, 270=низ)
PosDegree[NCell1] := 1; // 1-Если под угловой позицией "NCell1" есть схожая ячейка
end;
end;
end;
end;
SByS1 := -1; // С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон от 0 до 3)
SlPos1 := 1; // 1-Начало отсчета, 0-счет прерван
for StepDegree1 := 0 to 7 do
begin
if PosDegree[StepDegree1]=1 then // Считать углы от совпадающих ячеек
begin
if SlPos1=1 then // Если начало отсчета
begin
SByS1 := SByS1+1;
DegreeByXY[Nx,Ny,SByS1,0] := StepDegree1*45; // Начальный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
SlPos1 := 0;
end;
DegreeByXY[Nx,Ny,SByS1,1] := StepDegree1*45; // Конечный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
if (StepDegree1=7) and (PosDegree[0]=1) then // Если 315 градусов и 0 градусов, являются одной частью
begin
DegreeByXY[Nx,Ny,0,0] := DegreeByXY[Nx,Ny,SByS1,0]; // Начальная позиция с конца (например угол от 270 до 90 градусов)
SByS1 := SByS1-1;
end;
end
else SlPos1 := 1;
end;
if SByS1<3 then
for SByS2 := SByS1+1 to 3 do
DegreeByXY[Nx,Ny,SByS2,0] := -1; // Пометить незаполненные части массива
Until Step1<0;
end;
end;

// Расположение углов:
// 135 90 45
// 180 * 0
// 225 270 315

// Пояснение массива: DegreeByXY[ X, Y, a, b ]
// X , Y - координаты ячейки по горизонтали, вертикали.
// a - С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон переменной от 0 до 3)
// b – (диапазон переменной от 0 до 1) (отсчет угла против часовой). 0-угол ОТ "к примеру 90", 1-угол ДО "к примеру 270"
// Если DegreeByXY[ X, Y, a, 0 ] = -1 , значит части "a" не существует


Глобальные переменные:
NumByXY : array of array of integer;
DegreeByXY : array of array of array of array of integer;
Локальные переменные:
X1,Y1,w,h,w1,h1,w2,h2,Nx,Ny,Nx1,Ny1,NewNum,Step1,CikleStep,StepDegree1,NCell1,SByS1,SByS2,SlPos1 : integer;
Nxy : array of array of integer;
PosDegree : array of integer;

По поводу лабиринта, пока не разобрался...

К сообщению приложен файл. Размер - 130Kb
11 мар 19, 21:22    [21829784]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Gator
Member

Откуда: Москва
Сообщений: 14084
Судзоку ваяете?
11 мар 19, 21:38    [21829791]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
982183
Member

Откуда: VL
Сообщений: 2619
Arioch
а оптимизировать по скорости надо?
если нет - то задача примитивная

тут ключевой момент - "кратчайший путь", а не скорость выполнения.
Теория графов рулит.
+ возникнет проблема многовариантности кратчайшего пути.

Очень даже практическая задача.
12 мар 19, 00:52    [21829883]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
982183
Member

Откуда: VL
Сообщений: 2619
Но кроме теории графов есть вариант "в лоб"
12 мар 19, 00:55    [21829884]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Arioch
Member

Откуда:
Сообщений: 10598
982183,

угу, если скорость не важна просто начинаем заполнять от краёв к центру.

у краёв - клетки с рангом 1
потом у касающихся перворанговых клеток того же цвета - ставим ранг 2 и направление на перворанговую клетку.
потому у касающихся второранговых - ранг 3 и направление на ближайшую ранг-2-клетку

...и так пока не дойдём до "произвольной точки", ну или пока вообще полностью не обсчитаем массив.

в каком-то смысле мы так строим направленный граф, в котором каждая клдетка - узел.
12 мар 19, 12:54    [21830158]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить