Правила форума
Задача 3 Площади островов
Карта моря задана матрицей размера N*M, состоящей из квадратиков, в которых записаны 0 или 1. 0 –это вода,1-суша. Два квадратика с единицами принадлежат одному острову, если они имеют общую сторону. Найти количество островов и площадь каждого острова. Площади островов вывести в порядке неубывания.
Входные данные:
в первой строке два целых числа N и M (1<=N,M<=100)- размеры матрицы:;
В последующих N строках карта моря. В каждой строке M нулей и единиц, не разделенных пробелом.
Выходные данные:
В первой строке одно целое число – количество островов. Во второй строке площади островов, выведенные в порядке неубывания.
Пример:Input.txt Output.tx
2
3 4 2 4
0110
0000
1111
Алгоритм решения этой задачи следующий. Просматривая двумерный массив построчно, найти единицу, принадлежащую острову. Рекурсивно или двумя очередями найти площадь острова, при этом потопив его. Повторять процесс поиска до тех пор пока есть острова. Найденные площади островов запоминаем в одномерном массиве. Когда все острова будут потоплены, сортируем массив площадей по неубыванию и выводим результат.
program zad5;
Var a:array[0..200,0..200] of longint;
di:array[1..4] of integer=(-1,0,1,0); массивы приращений индексов
dj:array[1..4] of integer=( 0,1,0,-1);
pl:array[1..100]of longint; массив площадей островов
log:boolean;
n,m,i,j,k,s,i0,j0,kol:longint;
c:char;
Procedure closing;
begin
close(input); close(output); halt(0);
end;
Procedure qsort(l,r:integer); процедура сортировки
var i,j,x,p:integer;
begin
i:=l; j:=r;
x:=pl[(l+r) div 2];
repeat
while(pl[i]
while (x
if(i<=j) then
begin
p:=pl[i]; pl[i]:=pl[j]; pl[j]:=p;
inc(i); dec(j);
end;
until (i>j);
if (l
if (i
end;
procedure poisk(var i0,j0:integer); процедура поиска острова
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to m do
if a[i,j]=1 если остров найден
then
begin
i0:=i; запоминаем индексы единицы
j0:=j;
log:=true; отмечаем, что поиск успешен
exit; выходим
end;
end;
procedure top(i0,j0:integer); рекурсивная процедура нахождения
var i,j,k:integer; площади острова
begin
a[i0,j0]:=0; топим кусочек острова
inc(s); увеличиваем площадь на 1
for k:=1 to 4 do просматриваем четыре соседние клетки
begin
i:=i0+di[k];
j:=j0+dj[k];
if a[i,j]=1 если в клетке 1, то
then top(i,j); запускаем рекурсию от этой клетки
end;
end;
begin
assign(input,’input.txt’);
reset(input);
assign(output,’output.txt’);
rewrite(output);
readln(n,m); считываем размеры
fillchar(a,sizeof(a),0);
for i:=1 to n do
begin
for j:=1 to m do
begin
read©; считываем символ
if c=’1’
then a[i,j]:=1 и помещаем соответствующее значение в массив
else a[i,j]:=0;
end;
readln; переходим на новую строку
end;
repeat повторяем до тех пор пока есть острова
s:=0;
log:=false;
poisk(i0,j0); ищем остров
if log then если нашли
begin
top(i0,j0); находим его площадь
inc(kol); считаем остров
pl[kol]:=s; запоминаем площадь в массиве
end;
until not log;
qsort(1,kol); сортируем площади островов
writeln(kol); выводим результат
for i:=1 to kol do
write(pl[i],’ ‘);
closing;
end.
Вот второе решение этой задачи с использованием двух очередей.
program zad5;
Const nmax=10;
di:array[1..4]of integer=(0,1,0,-1);
dj:array[1..4]of integer=(1,0,-1,0);
Var n,m,io,jo,i,j,kolnew,kolold,kol:integer;
new,old:array[1..2,1..nmax] of integer; новая и старая очереди
a:array[0..nmax+1,0..nmax+1]of integer; карта
s:array[1..nmax*nmax div 2]of integer; массив площадей островов
log:boolean; сигнал о том есть ли острова
procedure Init;
begin
assign(input,’input.txt’);
reset(input);
readln(n,m); считываем размеры
fillchar(a,sizeof(a),0);
for i:=1 to n do
begin
for j:=1 to m do
begin
read©; считываем символ
if c=’1’
then a[i,j]:=1 и помещаем соответствующее значение в массив
else a[i,j]:=0;
end;
readln; переходим на новую строку
end;
end;
Procedure out; вывод результатов
var i:integer;
begin
assign(Output,’Output.txt’);
Rewrite(Output);
writeln(kol); выводим количество и площади островов
for i:=1 to kol do
write(s[i],’ ‘);
close(Output);
end;
procedure Poisk(var i0,j0:integer); ищем остров
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to m do
if a[i,j]=1 then если 1 найдена
begin
i0:=i; запоминаем ее координаты
j0:=j;
log:=true; сигнал о том, что остров найден
exit;
end;
end;
Procedure Solve;
var t:integer;
begin
kol:=0;
repeat повторяем пока есть острова
log:=false;
Poisk(io,jo);
if log then если остров найден
begin
inc(kol);
old[1,1]:=io; помещаем координаты острова в старую очередь
old[2,1]:=jo;
kolold:=1; количество элементов в старой очереди
s[kol]:=1; площадь острова под номером kol равна 1
Repeat пока есть элементы в новой очереди
повторяем
fillchar(new,sizeof(new),0); очищаем новую очередь
kolnew:=0; кол-во элементов в новой очереди равно 0
for i :=1 to kolold do бежим по старой очереди
begin
a[old[1,i],old[2,i]]:=0; топим кусочек острова
for t:=1 to 4 do просматриваем 4 соседние клетки
if a[old[1,i]+di[t],old[2,i]+dj[t]]=1 если в соседней клетке 1, то
then
begin
inc(kolnew); кол-во элементов в новой очереди
увеличиваем на 1
new[1,kolnew]:=old[1,i]+di[t]; заносим клетку с 1 в новую очередь
new[2,kolnew]:=old[2,i]+dj[t];
inc(s[kol]); увеличиваем площадь острова на 1
a[old[1,i]+di[t],old[2,i]+dj[t]]:=0; топим кусочек острова
end;
end;
old:=new; новую очередь делаем старой
kolold:=kolnew;
Until kolnew=0;
end
until not log;
end;
procedure sort; сортируем острова по неубыванию
площадей
var i,j,p:integer;
begin
for i:=1 to kol-1 do
for j:=i+1 to kol do
if s[i]>s[j]
then
begin p:=s[i]; s[i]:=s[j]; s[j]:=p; end;
end;
begin init; solve; sort; out; end.
 Олимпиадная задача, Не работает ни первое, ни второе решения |
