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

[RusSun]

Доброе время суток.
Есть небольшая задачка.
для простоты берем двумерный массив 3*3.

var m:array[1..3,1..3] of byte;

содержимое может быть таким

1)
|444|
|411|
|414|
2)
|444|
|414|
|441|
3)
|444|
|414|
|414|
Вопрос: как проще всего создать массив связанных ячеек?

например для 1)
должно быть
№ 1 2 3 4 5
i 1 1 1 2 3
j 1 2 3 1 1

Значение в 33 не подходит так как с ним связи нет

Сообщение отредактировано: RusSun - 28.03.18, 17:20

[Славян]

Не очень понятно, что означает "проще"? Это же обычный FloodFill, реализаций коего - вагоны!

[RusSun]

Всё. Понял.

[RusSun]

Кстати, по поводу

Цитата Славян @ 28.03.18, 17:32

реализаций коего - вагоны!

Вот такая вот ссылка wiki/Bitmap/Flood_fill
, ничего странного не наблюдаете?

Получается, да, но не точно.

procedure FF(i,j:integer;oldColor:byte;newColor:byte);
begin
  If ((i<0) Or (i>=14) Or (j<0) Or (j>=14)) Then Exit;
  if  m[i,j] = oldColor then begin;
  if m[i,j]<> newColor then   BeGin
  m[i,j]:=newColor;
 
  
   FF(i-1,j,oldColor,newColor);
   FF(i+1,j,oldColor,newColor);
   FF(i,j+1,oldColor,newColor);
  // FF(i,j-1,oldColor,newColor); //по идее должен быть, но тогда закрасит лишнее
 
                                EnD
                              end;
end;

так // FF(i,j-1,oldColor,newColor); добавляет лишние закрашенные ячейки по краю справа при значении 4 Прикреплённый файлSaved_String.txt (198 байт, скачиваний: 88)
тестовый файл прикрепил
или просто строкой.
текст загружаемого файла:

4342513324566431151635354654111656112455233143436451666534611266355166223125245362621226126335522252514253454321623365244163266365663366411232453321644531112564556322334511435413516543534214161322

тестил
на последовательности
3 1 4 2 3 6
должно получаться
3 9 12 19 26 35
выходит так
3 9 12 18 25 32
если раскомментить строку, то
3 9 14 21 29 40
посмотрел здесь geeksforgeeks
Но что-то я упускаю из виду. Заранее спасибо.
Здесь, то попробовал сделать в качестве теста.

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button10: TButton;
    Label1: TLabel;
    procedure Button10Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Seven;
    function GetStringFromFile(s:string):string;
    procedure Showmas;
    procedure Loadmas;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  type my_array =record
  i,j:byte;
  end;
var
  Form1: TForm1;
  m,before,after:array[1..14,1..14] of integer;
  place:array[1..196] of my_array;
  s:string;
  count:byte;
 
implementation
//uses kol;
{$R *.dfm}
 
procedure TForm1.Button2Click(Sender: TObject);
var m2:array[1..3,1..3] of byte;
//**********************************Метод обнуления масссива
procedure Nullmassive;
var i,j :byte;
begin
for i:= low(m2) to high(m2) do
  for j:= low(m2) to high(m2)do m2[j,i]:=0;
end;
//*********************************Метод вывода массива в текстовое поле
procedure Showmassive;
var i,j :byte;
      s:string;
begin
memo1.Lines.Add('');
 
for j:=low(m2) to high(m2) do begin
  for i:=low(m2) to high(m2) do  s:= s+intTostr(m2[j,i]);
                             memo1.Lines.Add(s);
                              s:='';
                              end;
end;
procedure FloodFill(i,j:byte;oldColor:byte;newColor:byte);
begin
 
  if  m2[i,j] = oldColor then begin;
 
  m2[i,j]:=newColor;
 
   floodFill(i-1,j,4,5);
   floodFill(i+1,j,4,5);
   floodFill(i,j+1,4,5);
   //floodFill(i,j-1,4,5); //если оставить закрашивает лишнее
                              end;
end;
 
//=============================== Основная работа
Begin
memo1.Clear;
Nullmassive;
m2[1,1]:=4; m2[1,2]:=1; m2[1,3]:=4;
m2[2,1]:=4; m2[2,2]:=1; m2[2,3]:=4;
m2[3,1]:=4; m2[3,2]:=4; m2[3,3]:=1;
Showmassive;
FloodFill(1,1,4,5);
Showmassive;
End;
 
 
procedure FF(i,j:integer;oldColor:byte;newColor:byte);
begin
  If ((i<0) Or (i>=14) Or (j<0) Or (j>=14)) Then Exit;
  if  m[i,j] = oldColor then begin;
  if m[i,j]<> newColor then   BeGin
  m[i,j]:=newColor;
 
  
   FF(i-1,j,oldColor,newColor);
   FF(i+1,j,oldColor,newColor);
   FF(i,j+1,oldColor,newColor);
  // FF(i,j-1,oldColor,newColor); //по идее должен быть, но тогда закрасит лишнее
 
                                EnD
                              end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var i,j:byte;
    s2:string;
begin
if m[1,1] <> 1 then Begin
 
memo1.Clear;
 
 FF(1,1,m[1,1],1);
memo1.Lines.Add(' ');
s2:='';
for j:=1 to 14 do  begin
  for i:=1 to 14 do  begin
                       s2:= s2+IntToStr(m[j,i]);
                      end;
                    memo1.Lines.Add(s2);
                    s2:='';
                    end;
form1.Caption:=form1.Caption+intTostr(1);
                      End;
 
end;
procedure TForm1.Button4Click(Sender: TObject);
var i,j:byte;
    s2:string;
begin
if m[1,1] <> 2 then Begin
memo1.Clear;
 FF(1,1,m[1,1],2);
memo1.Lines.Add(' ');
s2:='';
for j:=1 to 14 do  begin
  for i:=1 to 14 do  begin
                       s2:= s2+IntToStr(m[j,i]);
                      end;
                    memo1.Lines.Add(s2);
                    s2:='';
                    end;
  form1.Caption:=form1.Caption+intTostr(2);
                      End;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
var i,j:byte;
    s2:string;
begin
if m[1,1] <> 3 then Begin
memo1.Clear;
 FF(1,1,m[1,1],3);
memo1.Lines.Add(' ');
s2:='';
for j:=1 to 14 do  begin
  for i:=1 to 14 do  begin
                       s2:= s2+IntToStr(m[j,i]);
                      end;
                    memo1.Lines.Add(s2);
                    s2:='';
                    end;
  form1.Caption:=form1.Caption+intTostr(3);
                      End;
end;
 
procedure TForm1.Button6Click(Sender: TObject);
var i,j:byte;
    s2:string;
begin
if m[1,1] <> 4 then Begin
memo1.Clear;
 FF(1,1,m[1,1],4);
memo1.Lines.Add(' ');
s2:='';
for j:=1 to 14 do  begin
  for i:=1 to 14 do  begin
                       s2:= s2+IntToStr(m[j,i]);
                      end;
                    memo1.Lines.Add(s2);
                    s2:='';
                    end;
  form1.Caption:=form1.Caption+intTostr(4);
                    End;
end;
 
procedure TForm1.Button7Click(Sender: TObject);
var i,j:byte;
    s2:string;
begin
if m[1,1] <> 5 then Begin
memo1.Clear;
 FF(1,1,m[1,1],5);
memo1.Lines.Add(' ');
s2:='';
for j:=1 to 14 do  begin
  for i:=1 to 14 do  begin
                       s2:= s2+IntToStr(m[j,i]);
                      end;
                    memo1.Lines.Add(s2);
                    s2:='';
                    end;
  form1.Caption:=form1.Caption+intTostr(5);
                      End;
end;
 
procedure TForm1.Button8Click(Sender: TObject);
var i,j:byte;
    s2:string;
begin
if m[1,1] <> 6 then Begin
memo1.Clear;
 FF(1,1,m[1,1],6);
memo1.Lines.Add(' ');
s2:='';
for j:=1 to 14 do  begin
  for i:=1 to 14 do  begin
                       s2:= s2+IntToStr(m[j,i]);
                      end;
                    memo1.Lines.Add(s2);
                    s2:='';
                    end;
  form1.Caption:=form1.Caption+intTostr(6);
                      End;
end;
procedure TForm1.Seven;
var i,j:byte;
    s2:string;
begin
if m[1,1] <> 7 then Begin
memo1.Clear;
 FF(1,1,m[1,1],7);
memo1.Lines.Add(' ');
s2:='';
for j:=1 to 14 do  begin
  for i:=1 to 14 do  begin
                       s2:= s2+IntToStr(m[j,i]);
                      end;
                    memo1.Lines.Add(s2);
                    s2:='';
                    end;
  //form1.Caption:=form1.Caption+intTostr(7);
                      End;
end;
procedure Tform1.Showmas;
var i,j :byte;
      s:string;
begin
memo1.Lines.Add('');
 
for j:=low(m) to high(m) do begin
  for i:=low(m) to high(m) do  s:= s+intTostr(m[j,i]);
                             memo1.Lines.Add(s);
                              s:='';
                              end;
end;
procedure TForm1.Loadmas;
var i,j,f:byte;
begin
 f:=0;
  for I := low(m) to high(m) do
   for j := low(m) to high(m) do begin
                                inc(f);
                                m[i,j]:=StrToInt(s[f])
                                  end;
end;
 
function TForm1.GetStringFromFile(s:string):string;
 var loadfromfile :Tstringlist;
begin
if s<>'' then
  begin
  loadfromfile:=TStringlist.Create;
  loadfromfile.LoadFromFile(s);
  result:= loadfromfile.text;
  loadfromfile.Free
  end else result:= '';
  s:=''
end;
procedure TForm1.Button10Click(Sender: TObject);
var i,j,f:byte;
begin
   // memo1.Clear;
f:= m[1,1];
Seven;
//FF(1,1,f,7);
//Showmas;
count:=0;
for I := low(m) to high(m) do
   for j := low(m) to high(m) do
      if m[i,j] = 7 then begin inc(count); m[i,j] := f End;
 
     //FF(1,1,7,f);
   // Showmas;
   Label1.Caption:=IntToStr(count);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Caption:='Form ';
memo1.Clear;
s:=GetStringFromFile('Saved_String.txt');
loadmas;
Showmas;
 
end;
 
 
 
 
 
end.

Сообщение отредактировано: RusSun - 18.04.18, 02:04

[Славян]

Погодьте! У вас же в Паскале индексы с единицы, а проверяете за выход меньше нуля в FF! Надо проверять за выход единицы:

If ((i<1) Or (i>=14) Or (j<1) Or (j>=14)) Then Exit;

[RusSun]

Спасибо +1

If ((i<1) Or (i>14) Or (j<1) Or (j>14)) Then Exit;

Иначе ряд не войдет в диапазон =)

Сообщение отредактировано: RusSun - 16.05.18, 16:36