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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

в каком-то смысле мы так строим направленный граф, в котором каждая клдетка - узел.
12 мар 19, 12:54    [21830158]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

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


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]=0 then // 1-Считать углы от совпадающих ячеек, 0-от несовпадающих ячеек (+ поменять 1 на 0 ниже)
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]=0) then // Если 315 градусов и 0 градусов, являются одной частью(+поменять 1 на 0 выше)
begin
if SByS1>0 then // Если найдено две части или больше
begin
DegreeByXY[Nx,Ny,0,0] := DegreeByXY[Nx,Ny,SByS1,0]; // Начальная позиция с конца (например угол от 270 до 90 градусов)
SByS1 := SByS1-1;
end else DegreeByXY[Nx,Ny,0,1] := 360;
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;

Определение позиций промежуточных линий, внутри каждого фрагмента в таблице (на изображении)
Программы, с примером

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


Выполнить алгоритм: *Найти смежные ячейки в таблице + Углы*, от несовпадающих ячеек “if PosDegree[StepDegree1]=0 then” , “if (StepDegree1=7) and (PosDegree[0]=0) then”
---------------------------------------------------------

setlength(NumByXY2,0,0); setlength(NumByXY2,w,h);
setlength(DegreeByXY2,0,0,0,0); setlength(DegreeByXY2,w,h,4,2);
setlength(MChanged1,0); setlength(MChanged1,CikleStep+1);
// Скопировать массивы
for Y1 := 0 to h-1 do
begin
for X1 := 0 to w-1 do
begin
NumByXY2[X1,Y1] := NumByXY[X1,Y1];
for StepDegree1 := 0 to 3 do
begin
DegreeByXY2[X1,Y1,StepDegree1,0] := DegreeByXY[X1,Y1,StepDegree1,0];
DegreeByXY2[X1,Y1,StepDegree1,1] := DegreeByXY[X1,Y1,StepDegree1,1];
end;
end;
end;

ToOneLine1 := 0; // Если =1 значит идет процесс сведения толстой промежуточной линии в однопиксельную сплошную линию

repeat
for StepDegree1 := 0 to CikleStep do
MChanged1[StepDegree1] := 0; // Обновление массива
Changed1 := 0; // 1-Если в процессе, хоть одна позиция изменена
// Перемещение ячеек
for Y1 := 0 to h-1 do
begin
for X1 := 0 to w-1 do
if (NumByXY2[X1,Y1]>0) and (DegreeByXY2[X1,Y1,0,0]>-1)
and (DegreeByXY2[X1,Y1,1,0]=-1)
and (DegreeByXY2[X1,Y1,0,1]<360)
and (DegreeByXY2[X1,Y1,0,0]<>DegreeByXY2[X1,Y1,0,1])
then
begin
if DegreeByXY2[X1,Y1,0,0]<=DegreeByXY2[X1,Y1,0,1] then Deg2:=0 else Deg2:=360;
Deg1 := (((DegreeByXY2[X1,Y1,0,1]+Deg2)-DegreeByXY2[X1,Y1,0,0])/2)+DegreeByXY2[X1,Y1,0,0]; // Найти среднее значение угла
if Deg1>=360 then Deg1 := Deg1-360;
// В каком направлении перемещать ячейку
if (Deg1<=22.5) or (Deg1=337.5) then begin MoveX1 := -1; MoveY1 := 0; end else
if Deg1=45 then begin MoveX1 := -1; MoveY1 := 1; end else
if Deg1<=112.5 then begin MoveX1 := 0; MoveY1 := 1; end else
if Deg1=135 then begin MoveX1 := 1; MoveY1 := 1; end else
if Deg1<=202.5 then begin MoveX1 := 1; MoveY1 := 0; end else
if Deg1=225 then begin MoveX1 := 1; MoveY1 := -1; end else
if Deg1<=292.5 then begin MoveX1 := 0; MoveY1 := -1; end else
if Deg1=315 then begin MoveX1 := -1; MoveY1 := -1; end;
Nx1 := X1+MoveX1; Ny1 := Y1+MoveY1; // Координаты смещенной ячейки

ToOneLine2 := 1;
if ToOneLine1=1 then if NumByXY2[Nx1,Ny1]<0 then ToOneLine2 := -1; // Для сведения промежуточной в сплошную линию

if (Nx1>-1) and (Nx1<w) and (Ny1>-1) and (Ny1<h) then
if abs(NumByXY2[Nx1,Ny1])*ToOneLine2=NumByXY2[X1,Y1] then // Если фрагменты совпадают
begin
OppositeD := 1;
if (DegreeByXY2[Nx1,Ny1,0,0]=-1) or (ToOneLine1=1) then // Если нет направлений для смещения или сведение в сплошн. линию
begin
OppositeD := 0; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному напр. "Deg1"
end
else
begin
Step1 := -1;
for StepDegree1 := 0 to 3 do
if DegreeByXY2[Nx1,Ny1,StepDegree1,0]>-1 then
Step1 := Step1+1
else break;
if (Step1>-1) and (Step1<2) then
begin
OppositeD := 0;
for StepDegree1 := 0 to Step1 do
begin
if DegreeByXY2[Nx1,Ny1,StepDegree1,0]<=DegreeByXY2[Nx1,Ny1,StepDegree1,1]
then Deg3:=0 else Deg3:=360;
Deg2 := (((DegreeByXY2[Nx1,Ny1,StepDegree1,1]+Deg3)-DegreeByXY2[Nx1,Ny1,StepDegree1,0])/2)+
DegreeByXY2[Nx1,Ny1,StepDegree1,0]; // Найти среднее значение угла
if Deg2>=360 then Deg2 := Deg2-360;
if Deg2<=225 then Deg3 := 0 else Deg3 := 360;
dBord1 := (Deg2+112.5)-Deg3;
if Deg2>=112.5 then Deg3 := 0 else Deg3 := 360;
dBord2 := Deg3+(Deg2-112.5);
if dBord2>dBord1 then // Если границы второй ячейки в диапазоне "к примеру" - от 112.5 до 247.5
begin
if (Deg1>=dBord1) AND (Deg1<=dBord2) then OppositeD := 1; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному направлению "Deg1"
end
else // Если границы второй ячейки в диапазоне "к примеру" - от 292.5 до 67.5
begin
if (Deg1>=dBord1) OR (Deg1<=dBord2) then OppositeD := 1;
end;
end;
end;
end;

if OppositeD=0 then // Если в выбранной ячейке, направление перемещения схоже с первоначальным направлением
begin
MChanged1[NumByXY2[X1,Y1]] := 1; // Пометить измененный фрагмент
Changed1 := 1; // 1-Если в процессе, хоть одна позиция изменена
NumByXY2[X1,Y1] := -NumByXY2[X1,Y1]; // Ячейка перемещена
end;
end;
end;
end;

if ToOneLine1=1 then Changed1 := 0;
if (Changed1=0) and (ToOneLine1=0) then // Начать процесс сведения промежуточной линии в однопиксельную сплошную линию
begin
Changed1 := 1;
ToOneLine1 := 1;
end;

if Changed1=0 then
for StepDegree1 := 0 to CikleStep do
MChanged1[StepDegree1] := 1; // Обновить угловые позиции для всех фрагментов, перед выходом из цикла
// Определение углов
for Y1 := 0 to h-1 do
begin
for X1 := 0 to w-1 do
// Если найдена часть фрагмента и хотябы одна ячейка в этом фрагменте была передвинута
if (NumBYXY2[X1,Y1]>0) and (MChanged1[NumByXY2[X1,Y1]]=1) then
begin
NewNum := NumByXY2[X1,Y1]; // Номер фрагмента для сравнения
for StepDegree1 := 0 to 7 do PosDegree[StepDegree1] := 0; // Обновление массива
if Changed1=0 then // Выделить промежуточную линию, по коорд. "X1,Y1"
begin
ScanMyBitmap[Y1,X1].rgbRed := 0; // Закрасить пиксель черным цветом
ScanMyBitmap[Y1,X1].rgbGreen := 0;
ScanMyBitmap[Y1,X1].rgbBlue := 0;
end;
for h1 := 0 to 2 do
begin
h2 := h1-1;
Ny1 := Y1+h2;
if (Ny1>-1) and (Ny1<h) then
for w1 := 0 to 2 do
begin
w2 := w1-1;
Nx1 := X1+w2;
if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
if NumByXY2[Nx1,Ny1]=NewNum then // Если фрагменты совпадают
begin
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;

SByS1 := -1; // С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон от 0 до 3)
SlPos1 := 1; // 1-Начало отсчета, 0-счет прерван
for StepDegree1 := 0 to 7 do
begin
if PosDegree[StepDegree1]=ToOneLine1 then // 1-Считать углы от совпадающих, 0-от несовп. ячеек (+ поменять 1 на 0 ниже)
begin
if SlPos1=1 then // Если начало отсчета
begin
SByS1 := SByS1+1;
DegreeByXY2[X1,Y1,SByS1,0] := StepDegree1*45; // Начальный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
SlPos1 := 0;
end;
DegreeByXY2[X1,Y1,SByS1,1] := StepDegree1*45; // Конечный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
if (StepDegree1=7) and (PosDegree[0]=ToOneLine1) then // Если 315 и 0 град. являются одной частью (+ поменять 1 на 0 выше)
begin
if SByS1>0 then // Если найдено две части или больше
begin
DegreeByXY2[X1,Y1,0,0] := DegreeByXY2[X1,Y1,SByS1,0]; // Начальная позиция с конца (например угол от 270 до 90 градусов)
SByS1 := SByS1-1;
end else DegreeByXY2[X1,Y1,0,1] := 360;
end;
end
else SlPos1 := 1;
end;

if SByS1<3 then
for SByS2 := SByS1+1 to 3 do
DegreeByXY2[X1,Y1,SByS2,0] := -1; // Пометить незаполненные части массива
end;
end;
until Changed1=0;

// Все значения больше 0, в массиве NumBYXY2, являются промежуточными линиями, каждое число для своего фрагмента.
// Отрицательные числа сохраняют не используемые номера фрагментов, если убрать знак минуса “ abs( NumBYXY2[X1,Y1] ) ”.

// В последнем цикле, массив DegreeByXY2, заполняется углами от совпадающих ячеек, т.к. ToOneLine1 в последнем цикле =1.
// При необходимости можно заменить “ToOneLine1” на 0 - “if PosDegree[StepDegree1]=0 then”
// “ if (StepDegree1=7) and (PosDegree[0]=0) then ”

// NumByXY2, DegreeByXY2 – создавать не обязательно, можно использовать напрямую массивы - NumByXY, DegreeByXY


Глобальные переменные:
NumByXY, NumByXY2 : array of array of integer;
DegreeByXY, DegreeByXY2 : 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,
Changed1,MoveX1,MoveY1,OppositeD,ToOneLine1,ToOneLine2 : integer;
Deg1,Deg2,Deg3,dBord1,dBord2:extended;
Nxy : array of array of integer;
MChanged1,PosDegree : array of integer;


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

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

всё же научись исходники вставлят ьтак ,чтобы их читать можно было!

ведь даже кнопка "Помощь" есть!!!

https://www.sql.ru/faq/faq_topic.aspx?fid=202
29 мар 19, 15:05    [21847168]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
982183
Member

Откуда: VL
Сообщений: 2957
Arioch
982183,
угу, если скорость не важна просто начинаем заполнять от краёв к центру.
у краёв - клетки с рангом 1
потом у касающихся перворанговых клеток того же цвета - ставим ранг 2 и направление на перворанговую клетку.
потому у касающихся второранговых - ранг 3 и направление на ближайшую ранг-2-клетку
...и так пока не дойдём до "произвольной точки", ну или пока вообще полностью не обсчитаем массив.
в каком-то смысле мы так строим направленный граф, в котором каждая клдетка - узел.


А смысл начинать с краев?
От искомой точки гораздо легче будет.
Но это только определение возможности и длины пути.
А еще варианты пути надо отследить.
29 мар 19, 15:40    [21847248]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Arioch
Member

Откуда:
Сообщений: 10837
982183
От искомой точки гораздо легче будет.


зашли в тупик, идти некуда, программа загнулась

982183
А еще варианты пути надо отследить.


не надо

любой из кратчайших подходит под ответ
29 мар 19, 15:48    [21847260]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

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


 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]=0 then // 1-Считать углы от совпадающих ячеек, 0-от несовпадающих ячеек (+ поменять 1 на 0 ниже)
     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]=0) then // Если 315 градусов и 0 градусов, являются одной частью(+поменять 1 на 0 выше)
      begin
       if SByS1>0 then // Если найдено две части или больше
       begin
DegreeByXY[Nx,Ny,0,0] := DegreeByXY[Nx,Ny,SByS1,0]; // Начальная позиция с конца (например угол от 270 до 90 градусов)
        SByS1 := SByS1-1;
end else DegreeByXY[Nx,Ny,0,1] := 360;
      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;
+ НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ В ТАБЛИЦЕ + Углы + Промежуточные линии
Красным помечены значения которые нужно вводить.
Синим помечены значения на выходе.


Выполнить алгоритм: *Найти смежные ячейки в таблице + Углы*, от несовпадающих ячеек “if PosDegree[StepDegree1]=0 then” , “if (StepDegree1=7) and (PosDegree[0]=0) then”
---------------------------------------------------------

setlength(NumByXY2,0,0);              setlength(NumByXY2,w,h);
setlength(DegreeByXY2,0,0,0,0);       setlength(DegreeByXY2,w,h,4,2);
setlength(MChanged1,0);               setlength(MChanged1,CikleStep+1);
// Скопировать массивы
for Y1 := 0 to h-1 do
 begin
  for X1 := 0 to w-1 do
  begin
NumByXY2[X1,Y1] := NumByXY[X1,Y1];
   for StepDegree1 := 0 to 3 do
   begin
DegreeByXY2[X1,Y1,StepDegree1,0] := DegreeByXY[X1,Y1,StepDegree1,0];
DegreeByXY2[X1,Y1,StepDegree1,1] := DegreeByXY[X1,Y1,StepDegree1,1];
   end;
  end;
 end;

ToOneLine1 := 0; // Если =1 значит идет процесс сведения толстой промежуточной линии в однопиксельную сплошную линию

 repeat
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 0; // Обновление массива
  Changed1 := 0; // 1-Если в процессе, хоть одна позиция изменена
  // Перемещение ячеек
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   if (NumByXY2[X1,Y1]>0) and (DegreeByXY2[X1,Y1,0,0]>-1)
       and (DegreeByXY2[X1,Y1,1,0]=-1)
       and (DegreeByXY2[X1,Y1,0,1]<360)
       and (DegreeByXY2[X1,Y1,0,0]<>DegreeByXY2[X1,Y1,0,1])
   then
   begin
    if DegreeByXY2[X1,Y1,0,0]<=DegreeByXY2[X1,Y1,0,1] then Deg2:=0 else Deg2:=360;
    Deg1 := (((DegreeByXY2[X1,Y1,0,1]+Deg2)-DegreeByXY2[X1,Y1,0,0])/2)+DegreeByXY2[X1,Y1,0,0]; // Найти среднее значение угла
    if Deg1>=360 then Deg1 := Deg1-360;
    // В каком направлении перемещать ячейку
    if (Deg1<=22.5) or (Deg1=337.5) then begin MoveX1 := -1; MoveY1 := 0; end else
    if Deg1=45 then      begin MoveX1 := -1; MoveY1 := 1;  end else
    if Deg1<=112.5 then  begin MoveX1 := 0;  MoveY1 := 1;  end else
    if Deg1=135 then     begin MoveX1 := 1;  MoveY1 := 1;  end else
    if Deg1<=202.5 then  begin MoveX1 := 1;  MoveY1 := 0;  end else
    if Deg1=225 then     begin MoveX1 := 1;  MoveY1 := -1; end else
    if Deg1<=292.5 then  begin MoveX1 := 0;  MoveY1 := -1; end else
    if Deg1=315 then     begin MoveX1 := -1; MoveY1 := -1; end;
    Nx1 := X1+MoveX1;     Ny1 := Y1+MoveY1; // Координаты смещенной ячейки

    ToOneLine2 := 1;
    if ToOneLine1=1 then if NumByXY2[Nx1,Ny1]<0 then ToOneLine2 := -1;  // Для сведения промежуточной в сплошную линию 

    if (Nx1>-1) and (Nx1<w) and (Ny1>-1) and (Ny1<h) then
    if abs(NumByXY2[Nx1,Ny1])*ToOneLine2=NumByXY2[X1,Y1] then // Если фрагменты совпадают
    begin
     OppositeD := 1;
     if (DegreeByXY2[Nx1,Ny1,0,0]=-1) or (ToOneLine1=1) then // Если нет направлений для смещения или сведение в сплошн. линию
     begin
      OppositeD := 0; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному напр. "Deg1"
     end
     else
     begin
      Step1 := -1;
      for StepDegree1 := 0 to 3 do
      if DegreeByXY2[Nx1,Ny1,StepDegree1,0]>-1 then
       Step1 := Step1+1
      else break;
      if (Step1>-1) and (Step1<2) then
      begin
       OppositeD := 0;
       for StepDegree1 := 0 to Step1 do
       begin
        if DegreeByXY2[Nx1,Ny1,StepDegree1,0]<=DegreeByXY2[Nx1,Ny1,StepDegree1,1]
        then Deg3:=0 else Deg3:=360;
        Deg2 := (((DegreeByXY2[Nx1,Ny1,StepDegree1,1]+Deg3)-DegreeByXY2[Nx1,Ny1,StepDegree1,0])/2)+
                                                            DegreeByXY2[Nx1,Ny1,StepDegree1,0]; // Найти среднее значение угла
        if Deg2>=360 then Deg2 := Deg2-360;
         if Deg2<=225 then Deg3 := 0 else Deg3 := 360;
          dBord1 := (Deg2+112.5)-Deg3;
         if Deg2>=112.5 then Deg3 := 0 else Deg3 := 360;
          dBord2 := Deg3+(Deg2-112.5);
        if dBord2>dBord1 then // Если границы второй ячейки в диапазоне "к примеру" - от 112.5 до 247.5
        begin
         if (Deg1>=dBord1) AND (Deg1<=dBord2) then OppositeD := 1; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному направлению "Deg1"
        end
        else // Если границы второй ячейки в диапазоне "к примеру" - от 292.5 до 67.5
        begin
         if (Deg1>=dBord1) OR (Deg1<=dBord2) then OppositeD := 1;
        end;
       end;
      end;
     end; 

     if OppositeD=0 then // Если в выбранной ячейке, направление перемещения схоже с первоначальным направлением
     begin
      MChanged1[NumByXY2[X1,Y1]] := 1; // Пометить измененный фрагмент
      Changed1 := 1; // 1-Если в процессе, хоть одна позиция изменена
NumByXY2[X1,Y1] := -NumByXY2[X1,Y1]; // Ячейка перемещена
     end;
    end;
   end;
  end;

  if ToOneLine1=1 then Changed1 := 0; 
  if (Changed1=0) and (ToOneLine1=0) then // Начать процесс сведения промежуточной линии в однопиксельную сплошную линию
  begin
   Changed1 := 1;
   ToOneLine1 := 1;
  end;

  if Changed1=0 then
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 1; // Обновить угловые позиции для всех фрагментов, перед выходом из цикла
  // Определение углов
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   // Если найдена часть фрагмента и хотябы одна ячейка в этом фрагменте была передвинута
   if (NumBYXY2[X1,Y1]>0) and (MChanged1[NumByXY2[X1,Y1]]=1) then
   begin
    NewNum := NumByXY2[X1,Y1]; // Номер фрагмента для сравнения
    for StepDegree1 := 0 to 7 do PosDegree[StepDegree1] := 0; // Обновление массива
    if Changed1=0 then // Выделить промежуточную линию, по коорд. "X1,Y1"
    begin
ScanMyBitmap[Y1,X1].rgbRed := 0; // Закрасить пиксель черным цветом
ScanMyBitmap[Y1,X1].rgbGreen := 0;
ScanMyBitmap[Y1,X1].rgbBlue := 0;
    end;
    for h1 := 0 to 2 do
    begin
     h2 := h1-1;
     Ny1 := Y1+h2;
     if (Ny1>-1) and (Ny1<h) then
     for w1 := 0 to 2 do
     begin
      w2 := w1-1;
      Nx1 := X1+w2;
      if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
      if NumByXY2[Nx1,Ny1]=NewNum then // Если фрагменты совпадают
      begin
       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;

    SByS1 := -1; // С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон от 0 до 3)
    SlPos1 := 1; // 1-Начало отсчета, 0-счет прерван
    for StepDegree1 := 0 to 7 do
    begin
     if PosDegree[StepDegree1]=ToOneLine1 then // 1-Считать углы от совпадающих, 0-от несовп. ячеек (+ поменять 1 на 0 ниже)
     begin
      if SlPos1=1 then // Если начало отсчета
      begin
       SByS1 := SByS1+1;
DegreeByXY2[X1,Y1,SByS1,0] := StepDegree1*45; // Начальный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
       SlPos1 := 0;
      end;
DegreeByXY2[X1,Y1,SByS1,1] := StepDegree1*45; // Конечный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
      if (StepDegree1=7) and (PosDegree[0]=ToOneLine1) then // Если 315 и 0 град. являются одной частью (+ поменять 1 на 0 выше)
      begin
       if SByS1>0 then // Если найдено две части или больше
       begin
DegreeByXY2[X1,Y1,0,0] := DegreeByXY2[X1,Y1,SByS1,0]; // Начальная позиция с конца (например угол от 270 до 90 градусов)
        SByS1 := SByS1-1;
end else DegreeByXY2[X1,Y1,0,1] := 360;
      end;
     end
     else SlPos1 := 1;
    end;

    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do
DegreeByXY2[X1,Y1,SByS2,0] := -1; // Пометить незаполненные части массива
   end;
  end;
 until Changed1=0;
// Все значения больше 0, в массиве NumBYXY2, являются промежуточными линиями, каждое число для своего фрагмента.
// Отрицательные числа сохраняют не используемые номера фрагментов, если убрать знак минуса “ abs( NumBYXY2[X1,Y1] ) ”.

// В последнем цикле, массив DegreeByXY2, заполняется углами от совпадающих ячеек, т.к. ToOneLine1 в последнем цикле =1.
// При необходимости можно заменить “ToOneLine1” на 0 - “if PosDegree[StepDegree1]=0 then”
// “if (StepDegree1=7) and (PosDegree[0]=0) then”

// NumByXY2, DegreeByXY2 – создавать не обязательно, можно использовать напрямую массивы - NumByXY, DegreeByXY


Глобальные переменные:
NumByXY, NumByXY2 : array of array of integer;
DegreeByXY, DegreeByXY2 : 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,
Changed1,MoveX1,MoveY1,OppositeD,ToOneLine1,ToOneLine2 : integer;
Deg1,Deg2,Deg3,dBord1,dBord2:extended;
Nxy : array of array of integer;
MChanged1,PosDegree : array of integer;
Программы, с примером

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

Откуда:
Сообщений: 10837
можно и не вырывать из исходников отдельные строчки :-)

Ученик_333
  NewNum := NumInTable[Nxy[0,0],Nxy[0,1]];
29 мар 19, 19:57    [21847562]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 47
Arioch,
Эх, жаль, что есть только красный цвет...

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


Выполнить алгоритм: *Найти смежные ячейки в таблице + Углы*, от несовпадающих ячеек “if PosDegree[StepDegree1]=0 then” , “if (StepDegree1=7) and (PosDegree[0]=0) then”
---------------------------------------------------------
setlength(MassPointFromAtoB,0,0);     setlength(MassPointFromAtoB,w,h); 

 // *Пояснение массива PointFromAtoB, расписано в конце алгоритма
 for StepDegree1 := 0 to length(PointFromAtoB)-1 do //  От “0” до “Количество помеченных точек – 1”
 begin // Действия ниже нужны чтобы в процессе цикла не перемещать указанные точки
  if (PointFromAtoB[StepDegree1,0]>-1) and (PointFromAtoB[StepDegree1,1]>-1) then //Если для точки “StepDegree1” указаны коорд.
  MassPointFromAtoB[ PointFromAtoB[StepDegree1,0] , PointFromAtoB[StepDegree1,1] ] := StepDegree1+1; //Передать точку в массив
 end;

setlength(NumByXY2,0,0);              setlength(NumByXY2,w,h);
setlength(DegreeByXY2,0,0,0,0);       setlength(DegreeByXY2,w,h,4,2);
setlength(MChanged1,0);               setlength(MChanged1,CikleStep+1);
  // Скопировать массивы
for Y1 := 0 to h-1 do
 begin
  for X1 := 0 to w-1 do
  begin
   NumByXY2[X1,Y1] := NumByXY[X1,Y1];
   for StepDegree1 := 0 to 3 do
   begin
    DegreeByXY2[X1,Y1,StepDegree1,0] := DegreeByXY[X1,Y1,StepDegree1,0];
    DegreeByXY2[X1,Y1,StepDegree1,1] := DegreeByXY[X1,Y1,StepDegree1,1];
   end;
  end;
 end;

ToOneLine1 := 0; // Если =1 значит идет процесс сведения толстой промежуточной линии в однопиксельную сплошную линию

 repeat
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 0; // Обновление массива
  Changed1 := 0; // 1-Если в процессе, хоть одна позиция изменена
  // Перемещение ячеек
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   if (NumByXY2[X1,Y1]>0) and (DegreeByXY2[X1,Y1,0,0]>-1)
       and (DegreeByXY2[X1,Y1,1,0]=-1)
       and (DegreeByXY2[X1,Y1,0,1]<360)
       and (DegreeByXY2[X1,Y1,0,0]<>DegreeByXY2[X1,Y1,0,1])
   then
   begin
    if DegreeByXY2[X1,Y1,0,0]<=DegreeByXY2[X1,Y1,0,1] then Deg2:=0 else Deg2:=360;
    Deg1 := (((DegreeByXY2[X1,Y1,0,1]+Deg2)-DegreeByXY2[X1,Y1,0,0])/2)+DegreeByXY2[X1,Y1,0,0]; // Найти среднее значение угла
    if Deg1>=360 then Deg1 := Deg1-360;
    // В каком направлении перемещать ячейку
    if (Deg1<=22.5) or (Deg1=337.5) then begin MoveX1 := -1; MoveY1 := 0; end else
    if Deg1=45 then      begin MoveX1 := -1; MoveY1 := 1;  end else
    if Deg1<=112.5 then  begin MoveX1 := 0;  MoveY1 := 1;  end else
    if Deg1=135 then     begin MoveX1 := 1;  MoveY1 := 1;  end else
    if Deg1<=202.5 then  begin MoveX1 := 1;  MoveY1 := 0;  end else
    if Deg1=225 then     begin MoveX1 := 1;  MoveY1 := -1; end else
    if Deg1<=292.5 then  begin MoveX1 := 0;  MoveY1 := -1; end else
    if Deg1=315 then     begin MoveX1 := -1; MoveY1 := -1; end;
    Nx1 := X1+MoveX1;     Ny1 := Y1+MoveY1; // Координаты смещенной ячейки
    ToOneLine2 := 1;
    if ToOneLine1=1 then if NumByXY2[Nx1,Ny1]<0 then ToOneLine2 := -1;  // Для сведения промежуточной в сплошную линию 
    if (Nx1>-1) and (Nx1<w) and (Ny1>-1) and (Ny1<h) then
    if (abs(NumByXY2[Nx1,Ny1])*ToOneLine2=NumByXY2[X1,Y1]) // Если фрагменты совпадают
       and (MassPointFromAtoB[X1,Y1]=0) // Если точка не помечена
    then   
    begin
     OppositeD := 1;
     if (DegreeByXY2[Nx1,Ny1,0,0]=-1) or (ToOneLine1=1) then // Если нет направлений для смещения или сведение в сплошн. линию
     begin
      OppositeD := 0; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному напр. "Deg1"
     end
     else
     begin
      Step1 := -1;
      for StepDegree1 := 0 to 3 do
      if DegreeByXY2[Nx1,Ny1,StepDegree1,0]>-1 then
       Step1 := Step1+1
      else break;
      if (Step1>-1) and (Step1<2) then
      begin
       OppositeD := 0;
       for StepDegree1 := 0 to Step1 do
       begin
        if DegreeByXY2[Nx1,Ny1,StepDegree1,0]<=DegreeByXY2[Nx1,Ny1,StepDegree1,1]
        then Deg3:=0 else Deg3:=360;
        Deg2 := (((DegreeByXY2[Nx1,Ny1,StepDegree1,1]+Deg3)-DegreeByXY2[Nx1,Ny1,StepDegree1,0])/2)+
                                                            DegreeByXY2[Nx1,Ny1,StepDegree1,0]; // Найти среднее значение угла
        if Deg2>=360 then Deg2 := Deg2-360;
         if Deg2<=225 then Deg3 := 0 else Deg3 := 360;
          dBord1 := (Deg2+112.5)-Deg3;
         if Deg2>=112.5 then Deg3 := 0 else Deg3 := 360;
          dBord2 := Deg3+(Deg2-112.5);
        if dBord2>dBord1 then // Если границы второй ячейки в диапазоне "к примеру" - от 112.5 до 247.5
        begin
         if (Deg1>=dBord1) AND (Deg1<=dBord2) then OppositeD := 1; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному направлению "Deg1"
        end
        else // Если границы второй ячейки в диапазоне "к примеру" - от 292.5 до 67.5
        begin
         if (Deg1>=dBord1) OR (Deg1<=dBord2) then OppositeD := 1;
        end;
       end;
      end;
     end; 

     if OppositeD=0 then // Если в выбранной ячейке, направление перемещения схоже с первоначальным направлением
     begin
      MChanged1[NumByXY2[X1,Y1]] := 1; // Пометить измененный фрагмент
      Changed1 := 1; // 1-Если в процессе, хоть одна позиция изменена
NumByXY2[X1,Y1] := -NumByXY2[X1,Y1]; // Ячейка перемещена
     end;
    end;
   end;
  end;

  if ToOneLine1=1 then Changed1 := 0; 

  if (Changed1=0) and (ToOneLine1=0) then // Начать процесс сведения промежуточной линии в однопиксельную сплошную линию
  begin
   Changed1 := 1;
   ToOneLine1 := 1;
  end;

  if Changed1=0 then
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 1; // Обновить угловые позиции для всех фрагментов, перед выходом из цикла
  // Определение углов
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   // Если найдена часть фрагмента и хотябы одна ячейка в этом фрагменте была передвинута
   if (NumBYXY2[X1,Y1]>0) and (MChanged1[NumByXY2[X1,Y1]]=1) then
   begin
    NewNum := NumByXY2[X1,Y1]; // Номер фрагмента для сравнения
    for StepDegree1 := 0 to 7 do PosDegree[StepDegree1] := 0; // Обновление массива
    if Changed1=0 then // Выделить промежуточную линию, по коорд. "X1,Y1"
    begin
ScanMyBitmap[Y1,X1].rgbRed := 0; // Закрасить пиксель черным цветом
ScanMyBitmap[Y1,X1].rgbGreen := 0;
ScanMyBitmap[Y1,X1].rgbBlue := 0;
    end;
    for h1 := 0 to 2 do
    begin
     h2 := h1-1;
     Ny1 := Y1+h2;
     if (Ny1>-1) and (Ny1<h) then
     for w1 := 0 to 2 do
     begin
      w2 := w1-1;
      Nx1 := X1+w2;
      if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
      if NumByXY2[Nx1,Ny1]=NewNum then // Если фрагменты совпадают
      begin
       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;

    SByS1 := -1; // С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон от 0 до 3)
    SlPos1 := 1; // 1-Начало отсчета, 0-счет прерван
    for StepDegree1 := 0 to 7 do
    begin
     if PosDegree[StepDegree1]=ToOneLine1 then // 1-Считать углы от совпадающих, 0-от несовп. ячеек (+ поменять 1 на 0 ниже)
     begin
      if SlPos1=1 then // Если начало отсчета
      begin
       SByS1 := SByS1+1;
DegreeByXY2[X1,Y1,SByS1,0] := StepDegree1*45; // Начальный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
       SlPos1 := 0;
      end;
DegreeByXY2[X1,Y1,SByS1,1] := StepDegree1*45; // Конечный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
      if (StepDegree1=7) and (PosDegree[0]=ToOneLine1) then // Если 315 и 0 град. являются одной частью (+ поменять 1 на 0 выше)
      begin
       if SByS1>0 then // Если найдено две части или больше
       begin
DegreeByXY2[X1,Y1,0,0] := DegreeByXY2[X1,Y1,SByS1,0]; // Начальная позиция с конца (например угол от 270 до 90 градусов)
        SByS1 := SByS1-1;
end else DegreeByXY2[X1,Y1,0,1] := 360;
      end;
     end
     else SlPos1 := 1;
    end;

    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do
DegreeByXY2[X1,Y1,SByS2,0] := -1; // Пометить незаполненные части массива
   end;
  end;
 until Changed1=0;
// Все значения больше 0, в массиве NumBYXY2, являются промежуточными линиями, каждое число для своего фрагмента.
// Отрицательные числа сохраняют не используемые номера фрагментов, если убрать знак минуса “ abs( NumBYXY2[X1,Y1] ) ”.

// В последнем цикле, массив DegreeByXY2, заполняется углами от совпадающих ячеек, т.к. ToOneLine1 в последнем цикле =1.
// При необходимости можно заменить “ToOneLine1” на 0 - “if PosDegree[StepDegree1]=0 then”
// “if (StepDegree1=7) and (PosDegree[0]=0) then”

// NumByXY2, DegreeByXY2 – создавать не обязательно, можно использовать напрямую массивы - NumByXY, DegreeByXY


// Координаты помеченных точек в таблице.
// ПРИМЕР МАССИВА - PointFromAtoB: «PointFromAtoB[ 0=Номер точки , "0=X" или "1=Y" ]»
// PointFromAtoB : array of array [0..2] of integer;
// setlength(PointFromAtoB,2); // Создать две точки
// PointFromAtoB[0,0] := 3; // Координаты точки "0" в таблице по оси X
// PointFromAtoB[0,1] := 5; // Координаты точки "0" в таблице по оси Y
// PointFromAtoB[1,0] := 17; // Координаты точки "1" в таблице по оси X
// PointFromAtoB[1,1] := 6; // Координаты точки "1" в таблице по оси Y



Глобальные переменные:
NumByXY, NumByXY2 : array of array of integer;
DegreeByXY, DegreeByXY2 : 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,
Changed1,MoveX1,MoveY1,OppositeD,ToOneLine1,ToOneLine2 : integer;
Deg1,Deg2,Deg3,dBord1,dBord2:extended;
Nxy, MassPointFromAtoB : array of array of integer;
MChanged1,PosDegree : array of integer;
Программы, с примером

К сообщению приложен файл. Размер - 136Kb
8 апр 19, 18:10    [21856344]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 47
Программа
--------------------------------

Интересно, есть ли где нибудь реализация алгоритма A*, для дельфи, как на этом сайте http://qiao.github.io/PathFinding.js/visual/

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

Откуда:
Сообщений: 47
Программа
Найти несколько (коротких) путей из точки «А» в точку «Б»

К сообщению приложен файл. Размер - 131Kb
8 июл 19, 14:49    [21922742]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
Ученик_333
Member

Откуда:
Сообщений: 47
Ссылка те же, исправил пару ошибок.
К сожалению, программа находит не всегда кратчайшие пути, в некоторых местах может приврать…
В идеале, все-таки лучше пользоваться алгоритмом A*, только не понятно, возможно ли с его помощью найти несколько направлений.

К сообщению приложен файл. Размер - 147Kb
10 июл 19, 12:59    [21924138]     Ответить | Цитировать Сообщить модератору
 Re: Найти все смежные ячейки в таблице  [new]
DimaBr
Member

Откуда:
Сообщений: 11128
Для кого это всё ?
10 июл 19, 13:00    [21924140]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: [1] 2   вперед  Ctrl      все
Все форумы / Delphi Ответить