Задача про нефть. Решение.

Решение данной задачи любезно предоставлено старшим преподавателем Одесской Национальной Пищевой Академии Попковым Д.Н.

Комментарии отделены //двойным слешем.

program Project1;

var
    f1,f2:textfile;
    m,n,i,j,k,l:integer;
    a,b:array [0..100,0..100] of integer;
    c:array [0..10000] of integer;//хранит площадь пятен под i-м номером

procedure qSort(l,r:longint);  //сортировка
var i,j:longint;
    w,q:integer;
begin
  i := l; j := r;
  q := c[(l+r) div 2];
  repeat
    while (c[i] < q) do inc(i);
    while (q < c[j]) do dec(j);
    if (i <= j) then
    begin
      w:=c[i]; c[i]:=c[j]; c[j]:=w;
      inc(i); dec(j);
    end;
  until (i > j);
  if (l < j) then qSort(l,j);
  if (i < r) then qSort(i,r);
end;


begin
assign(f1,'OIL.DAT');
reset(f1);
assign(f2,'OIL.SOL');
rewrite(f2);
readln(f1, m, n);
k:=0;//хранит номер последнего определённого пятна
for i:=0 to m-1 do
  for j:=0 to n-1 do
    begin
    read(f1, a[i,j]);
    b[i,j]:=0; //массив b хранит 0 если область чиста, и номер пятна, если загрязнена
    if a[i,j]=1 then //если область загрязнена, то проверяем ячейку слева, сверху и слева-сверх по диагонали
      if ((i>0)and(b[i-1,j]<>0)) then  //сверяем с ячейкой слева, загрязнена ли она чем-либо
          begin
          b[i,j]:=b[i-1,j];//если да, то ячейке присваиваем номер пятна в соседней ячейке
          c[b[i,j]-1]:= c[b[i,j]-1]+1//увеличиваем площадь пятна с нужным номером(у индекса массива С отнимаем 1, так как нумерация массива идёт с 0, а пятен с 1)
          end
        else if((j>0)and(b[i,j-1]<>0)) then //сверху
            begin
            b[i,j]:=b[i,j-1];
            c[b[i,j]-1]:= c[b[i,j]-1]+1
            end
          else if((i>0)and(j>0)and(b[i-1,j-1]<>0)) then //по диагонали
              begin
              b[i,j]:=b[i-1,j-1];
              c[b[i,j]-1]:= c[b[i,j]-1]+1
              end
            else // если соседние ячейки чисты, то
              begin
              k:=k+1;//увеличиваем кол-во пятен
              b[i,j]:=k;//присваеваем ячейке номер нового пянта
              c[b[i,j]-1]:=1;//площадь нового пятна 1
              end;
    end;
writeln(f2, k); //выводим количество пятен
qsort(0,k-1); // сортируем массив с (по возрастанию площади)
i:=0;
while(i<=k-1) do //проходим по всему массиву с
  begin
  l:=1;// хранит кол-во пятен с одинаковой площадью
  while ((c[i]=c[i+1])and(i<k-1)) do //если площадь этого пятна равна площади следующего то
    begin
    l:=l+1;
    i:=i+1;
    end;
  writeln(f2, c[i], ' ', l);//выводим площадь пятна и кол-во таких пятен
  i:=i+1;
  end;
close(f1);
close(f2);
end.