5793. 【NOIP2008模拟】小S练跑步

Description

       小S是一个爱锻炼的孩子，他在放假期间坚持在A公园练习跑步。
      但不久后，他就开始为在重复的地点练习感到厌烦了，他就打算去B公园跑步。
      但是小S由于没有去过B公园，他不知道B公园是否适合练习跑步，又不知道在B公园怎样跑是最优的。所以小S就去B公园进行了一番勘测。
      小S在进行了一番勘测后，画出了一张地图，地图每一个位置上都辨识了小S到达该位置后不能往哪一个方位移动。其中有5种表示的符号：“U”代表不能向上移动，“D”代表不能向下移动，“L”代表不能向左移动，“R”代表不能向右移动，如果该位置有障碍物，小S到达那里后无法继续训练，就用“S”来代表。整个公园共有n行m列，小S会从第1行第1列出发，到第n行第m列结束他的练习。
      现在小S想要知道，从起点（即第1行第1列）到终点（第n行第m列），途中最少要改变几次方向（即上一次移动的方向和这一次移动的方向不一样）？
      注意：小S如在训练途中离开公园（即地图范围），则算是结束训练。

 

Input

      第1行两个整数n和m，它们的定义请看【题目描述】。
      第2~n+1行，每行有m个字符，表示小S的移动方向。

 

Output

      如果小S从第1行第1列出发无论如何都到达不了第n行第m列，输出“No Solution”，否则输出小S途中最少要改变方向的次数。

 

Solutions

　　　裸的广搜。

代码

const
  dx:array [1..4] of longint=(-1,1,0,0);
  dy:array [1..4] of longint=(0,0,-1,1);
var
  n,m:longint;
  a:array [0..501,0..501] of longint;
  d:array [0..501,0..501,0..4] of longint;
  list:array [0..3000001,1..4] of longint;
procedure init;
var
  i,j:longint;
  c:char;
begin
  readln(n,m);
  for i:=1 to n do
    begin
      for j:=1 to m do
        begin
          read(c);
          if c='U' then a[i,j]:=1;
          if c='D' then a[i,j]:=2;
          if c='L' then a[i,j]:=3;
          if c='R' then a[i,j]:=4;
          if c='S' then a[i,j]:=5;
        end;
      readln;
    end;
end;

function min(o,p:longint):longint;
begin
  if o<p then exit(o);
  exit(p);
end;

function fd(x,y,w,tot:longint):boolean;
begin
  if (a[x,y]=5) and ((x<>n) or (y<>m)) then exit(false);
  if (x>n) or (x<1) then exit(false);
  if (y>m) or (y<1) then exit(false);
  if tot>=d[x,y,w] then exit(false);
  if tot>=d[x,y,0]+1 then exit(false);
  d[x,y,0]:=min(d[x,y,0],tot);
  d[x,y,w]:=tot;
  exit(true);
end;

procedure bfs;
var
  i,j,k,head,tail,x,y,z,w,xx,yy,ww:longint;
begin
  head:=0; tail:=0;
  for i:=0 to 501 do
    for j:=0 to 501 do
      for k:=0 to 4 do
        d[i,j,k]:=maxlongint div 2;
  d[1,1,1]:=0; d[1,1,2]:=0;
  d[1,1,3]:=0; d[1,1,4]:=0;
  for i:=1 to 4 do
    if a[1,1]<>i then
      begin
        inc(tail);
           list[tail,1]:=1; list[tail,2]:=1;
           list[tail,3]:=i;
      end;
  while head<tail do
    begin
      inc(head);
      x:=list[head,1]; y:=list[head,2];
      z:=list[head,3]; w:=list[head,4];
      for i:=1 to 4 do
        if a[x,y]<>i then
          begin
            xx:=x+dx[i]; yy:=y+dy[i]; ww:=w;
        if z<>i then inc(ww);
        if not fd(xx,yy,i,ww) then continue;
            inc(tail);
           list[tail,1]:=xx; list[tail,2]:=yy;
        list[tail,3]:=i; list[tail,4]:=ww;
          end;
    end;
end;

procedure print;
var
  ans,i:longint;
begin
  ans:=d[0,0,0];
  for i:=1 to 4 do
    ans:=min(ans,d[n,m,i]);
  if ans<>d[0,0,0] then writeln(ans)
                   else writeln('No Solution');
end;

begin
  assign(input,'run.in');
  assign(output,'run.out');
  reset(input);
  rewrite(output);
  init;
  bfs;
  print;
  close(input);
  close(output);
end.