usaco 2.1 castle 2008.5.30

usaco 2.1 castle 2008.5.30

{

ID:

PROG: castle

LANG: PASCAL

}

program p_castle;

const

fin='castle.in';fout='castle.out';

maxn=50;

type

code1=array[1..2]of longint;

arr1=array[1..maxn,1..maxn]of integer;

arr2=array[1..maxn,1..maxn]of longint;

var

x:array[1..maxn*maxn]of code1;

a:arr1;b:arr2;f1,f2:text;

y:array[1..maxn*maxn]of longint;

i,j,x1,x2,n,m,l1,l2,max1,max2,ly,p1,p2:longint;

s,w:array[1..maxn,1..maxn]of boolean;

p3:char;

procedure init;

var i,j:longint;

begin

assign(f1,fin);reset(f1);

assign(f2,fout);rewrite(f2);

read(f1,m,n);

for i:=1 to n do for j:=1 to m do

read(f1,a[i,j]);

end;

procedure deal;

varr,pp,i,t1,t2,p1,p2:longint;

begin

repeat

t1:=x[x1,1];t2:=x[x1,2];

pp:=15-a[t1,t2];

r:=b[t1,t2];

p1:=t1+1;p2:=t2;

if pp>=8 then

begin

dec(pp,8);

if (s[p1,p2])and(p1<=n) then

begininc(y[r]);b[p1,p2]:=r;s[p1,p2]:=false;{避免重复累计r}

if w[p1,p2] then beginw[p1,p2]:=false;x[x2,1]:=p1;x[x2,2]:=p2;inc(x2);end;

end;

end;

if pp>=4 then

begin

dec(pp,4);

if (t2+1<=m)and(s[t1,t2+1])then

begininc(y[r]);b[t1,t2+1]:=r;s[t1,t2+1]:=false;

if(w[t1,t2+1])then beginw[t1,t2+1]:=false;x[x2,1]:=t1;x[x2,2]:=t2+1;inc(x2);end;

end;

end;

if pp>=2 then

begin

dec(pp,2);

if (t1-1>0)and(s[t1-1,t2])then

begininc(y[r]);b[t1-1,t2]:=r;s[t1-1,t2]:=false;

if (w[t1-1,t2]) then beginw[t1-1,t2]:=false;x[x2,1]:=t1-1;x[x2,2]:=t2;inc(x2);end;

end;

end;

if pp>=1 then

begin

if (t2-1>0)and(s[t1,t2-1])then

begininc(y[r]);b[t1,t2-1]:=r;s[t1,t2-1]:=false;

if (w[t1,t2-1]) then beginw[t1,t2-1]:=false;x[x2,1]:=t1;x[x2,2]:=t2-1;inc(x2);end;

end;

end;

inc(x1);

until (x2=x1);

end;

procedure find;

var i,j,i1,j1:longint;

begin

for j:=1 to m do

for i:=n downto 1 do

begin

j1:=j+1;

i1:=i-1;

if(i1>0)and(b[i,j]<>b[i1,j]) then

ify[b[i,j]]+y[b[i1,j]]>max2 then

begin

max2:=y[b[i,j]]+y[b[i1,j]];

p1:=i;p2:=j;p3:='N';

end;

if (j1<=m)and(b[i,j]<>b[i,j1]) then

if y[b[i,j]]+y[b[i,j1]]>max2then

begin

max2:=y[b[i,j1]]+y[b[i,j]];

p1:=i;p2:=j;p3:='E';

end;

end;

end;

procedure doit;

vark,j:longint;

begin

fillchar(s,sizeof(s),true);

fillchar(w,sizeof(w),true);

ly:=0;

fillchar(b,sizeof(b),0);

for k:=1 to n do for j:=1 to m do

if a[k,j]=15 then

begin

inc(ly);b[k,j]:=ly;

y[ly]:=1;w[k,j]:=false;

s[k,j]:=false;

end

else

if b[k,j]=0 then

begin

inc(ly);b[k,j]:=ly;

y[ly]:=1;x1:=1;x2:=2;

x[x1,1]:=k;x[x1,2]:=j;

w[k,j]:=false;s[k,j]:=false;

deal

end;

end;

{---------------main-----------------}

begin

max1:=-1;

max2:=-1;

init;

doit;

find;

fori:=1 to ly do

if y[i]>max1 then max1:=y[i];

writeln(f2,ly);

writeln(f2,max1);

writeln(f2,max2);

writeln(f2,p1,' ',p2,' ',p3);

close(f1); close(f2);

end.