ac1074.pas

同济大学 Online在线题库 AC源代码合集 程序设计竞赛必看资料

program tju1074;
const
  maxsize=10;
  maxmc=10;
  exp:array[1..maxmc]of word=(1,2,4,8,16,32,64,128,256,512);
  dx:array[1..4]of shortint=(-1,0,1,0);
  dy:array[1..4]of shortint=(0,1,0,-1);
var
  map:array[1..maxsize,1..maxsize]of char;
  lx,ly:array[1..sqr(maxsize)]of byte;
  mx,my:array[1..maxmc]of byte;
  dist:array[0..1023,1..maxsize,1..maxsize]of longint;
  ql:array[1..1024*sqr(maxsize)]of word;
  qx,qy:array[1..1024*sqr(maxsize)]of byte;
  n,m,i,j,sx,sy,ex,ey,lc,mc,f,r:longint;
  done:boolean;
procedure scan;
  var
    s,d,i,j:byte;
  begin
    for i:=1 to n do
      for j:=1 to m do
        if map[i,j]='.' then dist[f,i,j]:=maxlongint else dist[f,i,j]:=-1;
    for s:=1 to lc do begin
      case map[lx[s],ly[s]] of '^':d:=1;'>':d:=2;'v':d:=3;'<':d:=4;end;
      i:=lx[s];j:=ly[s];
      repeat
        dist[f,i,j]:=-1;
        case map[i,j] of
          '/':if odd(d) then inc(d) else dec(d);
          '\':d:=5-d;
        end;
        inc(i,dx[d]);inc(j,dy[d]);
      until (i<1) or (i>n) or (j<1) or (j>m);
    end;
    inc(f);
  end;
procedure search(m:byte);
  procedure reverse;
    begin
      if map[mx[m],my[m]]='/' then map[mx[m],my[m]]:='\' else map[mx[m],my[m]]:='/';
    end;
  begin
    if m=0 then
      scan
    else begin
      search(m-1);
      reverse;
      search(m-1);
      reverse;
    end;
  end;
procedure add(l,x,y:word);
  var
    d:longint;
  begin
    d:=dist[ql[f],qx[f],qy[f]]+1;
    if (x>0) and (x<=n) and (y>0) and (y<=m) and (d<dist[l,x,y]) then begin
      inc(r);ql[r]:=l;qx[r]:=x;qy[r]:=y;dist[l,x,y]:=d;
      if (x=ex) and (y=ey) then begin
        writeln(d);
        done:=true;
      end;
    end;
  end;
begin
  repeat
    lc:=0;mc:=0;
    readln(n,m);
    for i:=1 to n do begin
      for j:=1 to m do begin
        read(map[i,j]);
        case map[i,j] of
          'S':begin sx:=i;sy:=j;map[i,j]:='.';end;
          'E':begin ex:=i;ey:=j;map[i,j]:='.';end;
          '^','>','v','<':begin inc(lc);lx[lc]:=i;ly[lc]:=j;end;
          '/','\':begin inc(mc);mx[mc]:=i;my[mc]:=j;end;
        end;
      end;
      readln;
    end;

    f:=0;
    search(mc);

    f:=0;r:=1;ql[1]:=0;qx[1]:=sx;qy[1]:=sy;dist[0,sx,sy]:=0;done:=false;
    repeat
      inc(f);
      for i:=1 to 4 do
        add(ql[f],qx[f]+dx[i],qy[f]+dy[i]);
      for i:=1 to mc do
        add(ql[f] xor exp[i],qx[f],qy[f]);
    until (f=r) or done;
    if f=r then writeln('poor');
  until seekeof;
end.