Cod sursa(job #922913)

Utilizator patrascu_eugen96Patrascu Eugen patrascu_eugen96 Data 22 martie 2013 18:23:09
Problema Dreptunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.4 kb
program dreptunghiuriX;
type matrice=array[0..1001,0..1001] of 0..1;
     matrice2=array[0..1001,0..1001] of byte;
var a:matrice; b:matrice2;
    i,j,l,c,d,aux1,aux2,x,y,max,nrmax:integer;
    f,g:text;
procedure fill(i,j:integer);
begin
if a[i,j]=1 then begin
                 a[i,j]:=0;
                 fill(i-1,j); fill(i+1,j);
                 fill(i,j-1); fill(i,j+1);
                 end;
end;
begin
assign(f,'dreptunghiuri.in');reset(f);
assign(g,'dreptunghiuri.out');rewrite(g);
read(f,l,c);d:=0;
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 j:=0 to c+1 do begin a[0,j]:=0; a[l+1,j]:=0; end;
max:=0;
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];
                                                   nrmax:=0;
                                                   end;
                          if b[x-1,y-1]=max then inc(nrmax);
                         end;
  fill(i,j); inc(d);
  end;
write(g,d,' ',max,' ',nrmax);
close(f);close(g);
end.