среда, 26 марта 2014 г.

10А электив. Закраска островов на клеточной карте

На клеточной карте -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.

Комментариев нет:

Отправить комментарий