Олимпиадная задача. Не работает.

[everthinq]

Задача 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;
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:int eger;
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(c); считываем символ
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.