HAOI6000 - HAOI 6000

Tác giả: flashmt

Ngôn ngữ: Pascal

const dx:array[1..4] of longint=(-1,0,1,0);
      dy:array[1..4] of longint=(0,1,0,-1);
      maxn=1010;
var a:array[1..maxn,1..maxn] of byte;
    m,n,num,min:longint;
    di:array[1..4,0..1] of longint;

procedure rf;
var i,j:longint;
begin
     readln(m,n);
     for i:=1 to m do
     begin
          for j:=1 to n do
              read(a[i,j]);
          readln;
     end;
     di[1,0]:=3; di[1,1]:=2;
     di[2,0]:=3; di[2,1]:=4;
     di[3,0]:=1; di[3,1]:=4;
     di[4,0]:=1; di[4,1]:=2;
end;

function check(x,y:longint):boolean;
begin
     check:=(x>0) and (y>0) and (x<=m) and (y<=n);
end;

procedure mov(j:longint;var x,y,z,pre:longint;var kt:boolean);
begin
     x:=x+dx[j]; y:=y+dy[j]; pre:=j;
     if check(x,y) then z:=di[j,a[x,y]]
     else kt:=false;
end;

procedure move(var x,y,z,pre:longint;var kt:boolean);
begin
     case z of
     1:begin
            if pre=3 then mov(2,x,y,z,pre,kt)
            else mov(1,x,y,z,pre,kt);
       end;
     2:begin
            if pre=1 then mov(2,x,y,z,pre,kt)
            else mov(3,x,y,z,pre,kt);
       end;
     3:begin
            if pre=1 then mov(4,x,y,z,pre,kt)
            else mov(3,x,y,z,pre,kt);
       end;
     4:begin
            if pre=3 then mov(4,x,y,z,pre,kt)
            else mov(1,x,y,z,pre,kt);
       end;
     end
end;

procedure pr;
var i,j,x,y,z,dem,pre:longint; kt:boolean;
begin
     min:=maxlongint; num:=0;
     for i:=1 to n do
     begin
          x:=1; y:=i; kt:=true;
          if a[x,y]=0 then z:=1 else z:=4;
          dem:=1; pre:=3;
          repeat
                move(x,y,z,pre,kt);
                if not kt then break;
                inc(dem);
                if (x=m) and ((z=2) or (z=3)) then break;
          until false;
          if kt then
          begin
               if dem<min then
               begin
                    min:=dem;
                    num:=1;
               end
               else
               begin
                    if dem=min then inc(num);
               end;
          end;
     end;
end;

procedure wf;
begin
     if num<>0 then write(min,' ',num)
     else write(0,' ',0);
end;

begin
     rf;
     pr;
     wf;
end.

Download