Cod sursa(job #636386)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 19 noiembrie 2011 19:33:27
Problema DreptPal Scor 50
Compilator fpc Status done
Runda .com 2011 Marime 2.76 kb
Program dreptpal;
 var a,b:array [0..1000,0..1000] of longint;
     b1:array [1..1 shl 17] of char;
     n,m,i,j,max,x,y,hs,hj,aux,p,l:longint;
     s:string;
     fi,fo:text;
function citire:longint;
 var aux:longint;
begin
aux:=0;
 while (s[p]>='0') and (s[p]<='9') and (p<=l) do begin
                                            aux:=aux*10+ord(s[p])-48;
                                             if p=l then begin
                                                        read(fi, s);
                                                         p:=0;
                                                          l:=length(s);
                                                         end;
                                                      inc(p);
                                                  end;
 while ((s[p]<'0') or (s[p]>'9')) and (s<>'') do begin
                                                inc(p);
                                                if p>l then begin
                                                            read(fi, s);
                                                              p:=1;
                                                               l:=length(s);
                                                            end;
                                                  end;
citire:=aux;
end;
procedure solvesus(c:integer);
 var d,f:integer;
begin
 d:=x+1; f:=y-1;
  while (a[c,d]=a[c,f]) and (d<f) do begin inc(d); dec(f); end;
 if d=f then begin
              inc(hs);
              b[c,x+1]:=1; b[c,y-1]:=1;
               if c>1 then solvesus(c-1);
               end;
end;
procedure solvejos(c:integer);
 var d,f:integer;
begin
 d:=x+1; f:=y-1;
  while (a[c,d]=a[c,f]) and (d<f) do begin inc(d); dec(f); end;
 if d=f then begin
              inc(hj);
              b[c,x+1]:=1; b[c,y-1]:=1;
               if c<n then solvejos(c+1);
               end;
end;
procedure control();
begin
 x:=j-1; y:=j+1; hs:=0; hj:=0;
  while (a[i,x]=a[i,y]) and (x>=1) and (y<=m) do begin
                                           dec(x); inc(y);
                                                end;
if (b[i,x+1]<>1) or (b[i,y-1]<>1) then begin
      if i>1 then solvesus(i-1);
       if i<n then solvejos(i+1);
        if (hs+hj+1)*(y-x-1)>max then max:=(hs+hj+1)*(y-x-1);
         end;
b[i,x+1]:=1; b[i,y-1]:=1;
end;
begin
 assign(fi,'dreptpal.in');
  assign(fo,'dreptpal.out');
 settextbuf(fi,b1);
 reset(fi); rewrite(fo);
 readln(fi,n,m);
 if n>m then max:=n else max:=m;
  for i:=1 to n do begin
   read(fi,s); l:=length(s); p:=1;
   for j:=1 to m do a[i,j]:=citire;
    readln(fi);
  end;
  for i:=1 to n do
   for j:=2 to m-1 do
    if a[i,j-1]=a[i,j+1] then control();
 write(fo,max);
close(fo);
end.