usaco 2.1 castle 2008.5.30

来源:互联网 发布:网络加速器官网 编辑:程序博客网 时间:2024/06/16 23:51

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.

 

0 0
原创粉丝点击