На клеточной карте -1 обозначает море, 0 - сушу. Нужно пометить острова (группы клеток, соприкасающихся боковыми сторонами) цифрами, каждый остров - своей цифрой.
Пример
Исходная карта:
--------------------
-1 0 -1 -1 0
0 0 0 -1 0
-1 0 -1 -1 0
-1 -1 0 -1 0
-1 0 0 -1 -1
--------------------
Карта после закраски:
--------------------
-1 1 -1 -1 2
1 1 1 -1 2
-1 1 -1 -1 2
-1 -1 3 -1 2
-1 3 3 -1 -1
--------------------
Видим, что на карте 3 острова. Остров №1 состоит из 5 клеток, №2 из четырех, №3 из трех.
Для закраски островов используем очередь. Найдя очередную непомеченную клетку-сушу, помещаем ее в очередь и начинаем от нее процесс закраски. Извлекаем клетку из очереди, помечаем ее номером острова, а в очередь добавляем все соседние с ней непомеченные клетки - участки суши. Закраска закончится, когда очередь опустеет (все клетки острова окажутся в нее добавлены, а затем извлечены и помечены). Закраска одного острова представляет собой волновой алгоритм - поиск в ширину.
Изучите программу, реализующую этот алгоритм, и выполните предложенные задания.
program FillQueue;
{Очередь. Заливка области}
{Самостоятельно выполните задания:
(6) Заполнить пропуски в процедуре Paint
(7) Вывести количество островов на карте
(8) Вывести площадь каждого острова
(9) Вывести периметр каждого острова}
Type
point = record
x,y : integer; {координаты точки}
end;
const
N=1000;
xmax = 5;
ymax = 5;
map : array[1..xmax,1..ymax] of integer=((-1, 0,-1,-1, 0),
( 0, 0, 0,-1, 0),
(-1, 0,-1,-1, 0),
(-1,-1, 0,-1, 0),
(-1, 0, 0,-1,-1));
var
a : array[1..xmax,1..ymax] of integer; {карта для работы}
Que : array[1..N] of point; {очередь; ее элементы - точки карты}
head, tail : integer; {голова и хвост очереди}
k: integer; {номер очередного острова}
pt : point; {точка для работы}
x1, y1 : integer; {координаты для работы}
i, j: integer;
{Очередь.
Если голова и хвост указывают на один и тот же элемент массива, то очередь пуста
Хвост указывает на номер элемента массива, который будет заполнен следующим
Последний элемент массива не заполняется}
Function Full:boolean;
begin
if tail=N then Full:=true else Full:=false;
end;
Function Empty:boolean;
begin
if tail=head then Empty:=true else Empty:=false;
end;
Procedure AddQue(a:point); {добавление элемента в очередь}
begin
if not(Full) then
begin
que[tail]:=a;
inc(tail);
end
else
writeln('Очередь полна');
end;
Procedure OutQue(Var a:point); {извлечение элемента из очереди}
begin
if not(Empty) then
begin
a:=que[head];
inc(head);
end
else
writeln('Очередь пуста');
end;
procedure ShowMap; {процедура вывода карты на экран}
var i, j: integer;
begin
writeln('--------------------');
for i:=1 to xmax do begin
for j:=1 to ymax do
write(A[i,j]:3);
writeln;
end;
writeln('--------------------');
end;
procedure Paint; {процедура закраски острова}
var i,j : integer;
begin
while not(Empty) do {пока очередь не опустела}
begin
OutQue(pt); {извлекаем из нее элемент}
x1:=pt.x; y1:=pt.y; {запоминаем его координаты}
a[x1,y1]:=k; {закрашиваем извлеченный элемент}
{проверяем, являются ли соседние с ним клетки непомеченной сушей}
if (x1 > 1) and (a[x1-1,y1]=0) {если клетка сверху есть и она является непомеченной сушей}
then begin pt.x:=x1-1; pt.y:=y1; AddQue(pt) end; {собираем ее координаты в запись pt и помещаем ее в очередь}
if () and () then begin end;
if () and () then begin end;
if (y1 < ymax) and (a[x1,y1+1]=0) {если клетка справа есть и она является непомеченной сушей}
then begin pt.x:=x1; pt.y:=y1+1; AddQue(pt) end; {собираем ее координаты в запись pt и помещаем ее в очередь}
end;
end;
begin
{считываем карту из константы}
for i:=1 to xmax do
for j:=1 to ymax do
A[i,j]:=map[i,j];
{вывод исходной карты на экран}
writeln ( 'Исходная карта:' );
ShowMap;
{подготовка к работе}
k:=0; {вначале считаем, что островов нет}
for i:=1 to xmax do
for j:=1 to ymax do
if a[i,j]=0 then {если нашли непомеченную сушу}
begin
inc(k); {то увеличиваем счетчик количества островов}
head:=1; tail:=1; {готовим очередь к работе}
pt.x:=i; pt.y:=j; {запоминаем координаты клетки с сушей}
AddQue(pt); {помещаем эту точку в очередь}
Paint; {запускаем процедуру закрашивания этого острова}
end;
writeln ( 'Карта после закраски:' );
ShowMap;
end.
Комментариев нет:
Отправить комментарий