ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Найти все смежные ячейки в таблице
25 сообщений из 34, страница 1 из 2
  1  все
Найти все смежные ячейки в таблице
    #39782587
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Написал небольшой алгоритм, может кому-то пригодится, работает шустро.
Программа, с примером
-------------------------------------------------------------

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

w := 100; // Количество ячеек в таблице по горизонтали
h := 100; // Количество ячеек в таблице по вертикали
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
 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]"
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
   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" не была помечена
Код: pascal
1.
2.
3.
4.
5.
6.
          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)
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
       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;
...
Рейтинг: 0 / 0
05.03.2019, 16:22
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39782599
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
Ученик_333Написал небольшой алгоритм

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

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

и в классических книгах, например http://sulfurzona.com/?art=201
Р. Джордейн. «Справочник программиста персональных компьютеров типа IBM PC, XT и AT»
...
Рейтинг: 0 / 0
05.03.2019, 16:30
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39782601
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
Xonix что ли пишешь ?
...
Рейтинг: 0 / 0
05.03.2019, 16:31
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39782684
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Ariochалгоритм заливки области картинки одним цветом (flood fill)
Ну вот, точно. Старая-добрая заливка, не додумался.. Спасибо)
...
Рейтинг: 0 / 0
05.03.2019, 19:11
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39782702
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
Ученик_333,

ты ж, глaвное, на рисунке же сам её нарисовал
...
Рейтинг: 0 / 0
05.03.2019, 19:51
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39782775
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Arioch,

Простая невнимательность)
...
Рейтинг: 0 / 0
06.03.2019, 07:31
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39782778
982183
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
982183
Участник
Если хочешь поработать.
Заполни таблицу нулями и единичками.
А потом найди кратчайший путь с произвольной точки до границы массива
по одинаково заполненным ячейкам.
...
Рейтинг: 0 / 0
06.03.2019, 07:44
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39783020
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Интересное предложение, надо подумать...
...
Рейтинг: 0 / 0
06.03.2019, 15:00
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39783229
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
982183,

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

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

напоминает одну мелко-олимпиадную: в лабиринт (клетчатое поле с наримованными где-то препятствиями) выпускают робота, у робота никаких глаз нету, он лабиринта не видит и ничего о нём не знает, где его выпустили - тоже. Но ему дают какой-то гарантированно выводящий наружу путь (типа шаг вверх, шаг вправо, шаг влево). Нужно построить наикратчайший гарантированного выводящий наружу.
...
Рейтинг: 0 / 0
06.03.2019, 20:43
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39784690
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Исправил пару ошибок.
Программа, с примером
 
НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ В ТАБЛИЦЕ Красным помечены значения которые нужно вводить.
Синим помечены значения на выходе.

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;

По поводу лабиринта, пока не разобрался...
...
Рейтинг: 0 / 0
11.03.2019, 21:22
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39784693
Фотография Gator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Gator
Участник
Судзоку ваяете?
...
Рейтинг: 0 / 0
11.03.2019, 21:38
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39784723
982183
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
982183
Участник
Ariochа оптимизировать по скорости надо?
если нет - то задача примитивная

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

Очень даже практическая задача.
...
Рейтинг: 0 / 0
12.03.2019, 00:52
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39784724
982183
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
982183
Участник
Но кроме теории графов есть вариант "в лоб"
...
Рейтинг: 0 / 0
12.03.2019, 00:55
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39784836
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
982183,

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

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

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

в каком-то смысле мы так строим направленный граф, в котором каждая клдетка - узел.
...
Рейтинг: 0 / 0
12.03.2019, 12:54
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39793539
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Добавлены обозначения 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;
...
Рейтинг: 0 / 0
29.03.2019, 13:03
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39793653
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
Ученик_333,

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

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

https://www.sql.ru/faq/faq_topic.aspx?fid=202
...
Рейтинг: 0 / 0
29.03.2019, 15:05
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39793702
982183
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
982183
Участник
Arioch982183,
угу, если скорость не важна просто начинаем заполнять от краёв к центру.
у краёв - клетки с рангом 1
потом у касающихся перворанговых клеток того же цвета - ставим ранг 2 и направление на перворанговую клетку.
потому у касающихся второранговых - ранг 3 и направление на ближайшую ранг-2-клетку
...и так пока не дойдём до "произвольной точки", ну или пока вообще полностью не обсчитаем массив.
в каком-то смысле мы так строим направленный граф, в котором каждая клдетка - узел.

А смысл начинать с краев?
От искомой точки гораздо легче будет.
Но это только определение возможности и длины пути.
А еще варианты пути надо отследить.
...
Рейтинг: 0 / 0
29.03.2019, 15:40
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39793713
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
982183От искомой точки гораздо легче будет.

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

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

не надо

любой из кратчайших подходит под ответ
...
Рейтинг: 0 / 0
29.03.2019, 15:48
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39793863
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
 
НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ В ТАБЛИЦЕ + Углы Красным помечены значения которые нужно вводить.
Синим помечены значения на выходе.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
 w := 100;  // Количество ячеек в таблице по горизонтали  
 h := 100;  // Количество ячеек в таблице по вертикали 
 [code=pascal]
 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]"
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
    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 // Если числа совпадают
Код: pascal
1.
2.
3.
4.
5.
6.
       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)
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
        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"
Код: pascal
1.
2.
       SlPos1 := 0;
      end;

DegreeByXY[Nx,Ny,SByS1,1] := StepDegree1*45; // Конечный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
Код: pascal
1.
2.
3.
4.
      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 градусов)
Код: pascal
1.
        SByS1 := SByS1-1;

end else DegreeByXY[Nx,Ny,0,1] := 360;
Код: pascal
1.
2.
3.
4.
5.
6.
      end;
     end
     else SlPos1 := 1;
    end;
    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do

DegreeByXY[Nx,Ny,SByS2,0] := -1; // Пометить незаполненные части массива
Код: pascal
1.
2.
3.
   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”
---------------------------------------------------------
Код: plaintext
1.
2.
3.
4.
 [code=pascal]
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);

// Скопировать массивы
Код: pascal
1.
2.
3.
4.
for Y1 := 0 to h-1 do
 begin
  for X1 := 0 to w-1 do
  begin

NumByXY2[X1,Y1] := NumByXY[X1,Y1];
Код: pascal
1.
2.
   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];
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
   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]; // Ячейка перемещена
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
     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;
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
    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"
Код: pascal
1.
2.
       SlPos1 := 0;
      end;

DegreeByXY2[X1,Y1,SByS1,1] := StepDegree1*45; // Конечный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
Код: pascal
1.
2.
3.
4.
      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 градусов)
Код: pascal
1.
        SByS1 := SByS1-1;

end else DegreeByXY2[X1,Y1,0,1] := 360;
Код: pascal
1.
2.
3.
4.
5.
6.
7.
      end;
     end
     else SlPos1 := 1;
    end;

    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do

DegreeByXY2[X1,Y1,SByS2,0] := -1; // Пометить незаполненные части массива
Код: pascal
1.
2.
3.
   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;
Программы, с примером
...
Рейтинг: 0 / 0
29.03.2019, 18:06
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39793917
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Arioch
Участник
можно и не вырывать из исходников отдельные строчки :-)

Ученик_333
Код: pascal
1.
  NewNum := NumInTable[Nxy[0,0],Nxy[0,1]];
...
Рейтинг: 0 / 0
29.03.2019, 19:57
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39798357
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Arioch,
Эх, жаль, что есть только красный цвет...

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

Выполнить алгоритм: *Найти смежные ячейки в таблице + Углы* , от несовпадающих ячеек “if PosDegree[StepDegree1]=0 then” , “if (StepDegree1=7) and (PosDegree[0]= 0 ) then”
---------------------------------------------------------
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
 [code=pascal]
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]; // Ячейка перемещена
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
     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;
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
    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"
Код: pascal
1.
2.
       SlPos1 := 0;
      end;

DegreeByXY2[X1,Y1,SByS1,1] := StepDegree1*45; // Конечный угол (от 0 до 360 градусов) в ячейке "Nx, Ny"
Код: pascal
1.
2.
3.
4.
      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 градусов)
Код: pascal
1.
        SByS1 := SByS1-1;

end else DegreeByXY2[X1,Y1,0,1] := 360;
Код: pascal
1.
2.
3.
4.
5.
6.
7.
      end;
     end
     else SlPos1 := 1;
    end;

    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do

DegreeByXY2[X1,Y1,SByS2,0] := -1; // Пометить незаполненные части массива
Код: pascal
1.
2.
3.
   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;
Программы, с примером
...
Рейтинг: 0 / 0
08.04.2019, 18:10
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39833096
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Программа
--------------------------------

Интересно, есть ли где нибудь реализация алгоритма A*, для дельфи, как на этом сайте http://qiao.github.io/PathFinding.js/visual/
...
Рейтинг: 0 / 0
03.07.2019, 09:03
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39834996
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Программа
Найти несколько (коротких) путей из точки «А» в точку «Б»
...
Рейтинг: 0 / 0
08.07.2019, 14:49
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39835926
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Ссылка те же, исправил пару ошибок.
К сожалению, программа находит не всегда кратчайшие пути, в некоторых местах может приврать…
В идеале, все-таки лучше пользоваться алгоритмом A*, только не понятно, возможно ли с его помощью найти несколько направлений.
...
Рейтинг: 0 / 0
10.07.2019, 12:59
| Ответить | Цитировать | Написать  
Найти все смежные ячейки в таблице
    #39835928
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник
Для кого это всё ?
...
Рейтинг: 0 / 0
10.07.2019, 13:00
| Ответить | Цитировать | Написать  
25 сообщений из 34, страница 1 из 2
  1  все
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Найти все смежные ячейки в таблице
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&tid=2039278]:
 0ms
get settings:
 7ms
get forum list:
 21ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 166ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 60ms
get tp. blocked users:
 1ms
others: 216ms
total:  490ms
созд. / загр.: 490ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]