Cod sursa(job #874045)

Utilizator rares96cheseliRares Cheseli rares96cheseli Data 7 februarie 2013 20:53:20
Problema Dreptunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.44 kb
program dreptunghiuri;
type matrice2=array[0..1001,0..1001] of 0..1;
     matrice=array[0..1001,0..1001] of byte;
var  a:matrice2; b:matrice;
     i,j,l,c,nrd,nrord,x,y,aux1,aux2,max:word;
     f,g:text;

procedure fill(x,y:integer);
begin
if a[x,y]=1 then begin
                 a[x,y]:=0;
                 fill(x-1,y); fill(x+1,y);
                 fill(x,y+1); fill(x,y-1);
                 end;
end;

begin
assign(f,'dreptunghiuri.in');reset(f);
assign(g,'dreptunghiuri.out');rewrite(g);
readln(f,l,c);
for i:=1 to l do begin
 for j:=1 to c do read(f,a[i,j]);
 readln(f);
end;
for i:=0 to l+1 do begin
                   a[i,0]:=0; a[i,c+1]:=0;
                   end;
for i:=0 to c+1 do begin
                   a[0,i]:=0; a[l+1,i]:=0;
                   end;
max:=1;
for i:=1 to l do
 for j:=1 to c do if (a[i,j]=1)then
  begin
   x:=i; y:=j;
   while (a[i,y]=1) do inc(y);
   while (a[x,j]=1) do inc(x);
   for aux1:=i to x-1 do
    for aux2:=j to y-1 do begin
                           inc(b[aux1,aux2]);
                           if b[aux1,aux2]>max then begin
                                                    max:=b[aux1,aux2];
                                                    nrord:=0;
                                                    end;
                          end;
   if b[x-1,y-1]=max then inc(nrord);
   fill(i,j); inc(nrd);
  end;
writeln(g,nrd,' ',max,' ',nrord);
close(f);close(g);
end.