麻将游戏（广度优先搜索）

Description

　　在一种"麻将"游戏中，游戏是在一个有W＊H格子的矩形平板上进行的。每个格子可以放置一个麻将牌，也可以不放（如图所示）。玩家的目标是将平板上的所有可通过一条路径相连的两张相同的麻将牌，从平板上移去。最后如果能将所有牌移出平板，则算过关。 
　　这个游戏中的一个关键问题是：两张牌之间是否可以被一条路径所连接，该路径满足以下两个特性： 
　　1. 它由若干条线段组成，每条线段要么是水平方向，要么是垂直方向。 
　　2. 这条路径不能横穿任何一个麻将牌 (但允许路径暂时离开平板)。 
　　这是一个例子： 
 
　　在（1，3）的牌和在(4, 4)的牌可以被连接。(2, 3)和(3, 4)不能被连接。 
　　你的任务是编一个程序，检测两张牌是否能被一条符合以上规定的路径所连接。 

Input

　　输入文件的第一行有两个整数w，h （1<=w，h<=75），表示平板的宽和高。接下来h行描述平板信息，每行包含w个字符，如果某格子有一张牌，则这个格子上有个'X'，否则是一个空格。平板上最左上角格子的坐标为（1，1），最右下角格子的坐标为（w,h）。接下来的若干行，每行有四个数x1， y1， x2， y2 ，且满足1<=x1,x2<=w，1<=y1,y2<=h，表示两张牌的坐标（这两张牌的坐标总是不同的）。如果出现连续四个0，则表示输入结束。

Output

　　输出文件中，对于每一对牌输出占一行，为连接这一对牌的路径最少包含的线段数。如果不存在路径则输出0。

Sample Input

 

5 4 

XXXXX 

X   X 

 XXX X

 XXX 

 2 3 5 3 

1 3 4 4 

 2 3 3 4 

0 0 0 0 

 

Sample Output

4

3

0

解题思路：先读入数据，用数组进行标记，当它不符合结束条件的时候就循环，用广搜，找到起点后开始向四周搜索，如果没有障碍物就进行记录，如果有障碍物就结束该循环，最后按要求输出答案即可。

程序：

const

  maxn=75;

  max=1000000;

var

  a,f:array[0..maxn+1,0..maxn+1] of longint;

  x1,x2,y1,y2,w,h:longint;

procedure init;

  var

    i,j:longint;

    ch:char;

  begin

    readln(w,h);

    for i:=1 to h do

      begin

        for j:=1 to w do

          begin

            read(ch);

            if ch='X' then a[i,j]:=1 else a[i,j]:=0;

          end;

        readln;

      end;

end;

procedure bfs;

  var

    i,j,t,k:longint;

    flag:boolean;

  begin

    for i:=0 to h+1 do

      for j:=0 to w+1 do

        f[i,j]:=max;

    f[x1,y1]:=0;

    t:=1;

    repeat

      flag:=false;

      for i:=0 to h+1 do

        for j:=0 to w+1 do

          if f[i,j]=t-1 then

            begin

              for k:=j-1 downto 0 do

                begin

                  if a[i,k]=1 then break;

                  if t<=f[i,k] then

                    begin

                      f[i,k]:=t;

                      flag:=true;

                    end;

                end;

              for k:=j+1 to w+1 do

                begin

                  if a[i,k]=1 then break;

                  if t<=f[i,k] then

                    begin

                      f[i,k]:=t;

                      flag:=true;

                    end;

            end;

          for k:=i-1 downto 0 do

            begin

              if a[k,j]=1 then break;

              if t<=f[k,j] then

                begin

                  f[k,j]:=t;

                  flag:=true;

                end;

              end;

            for k:=i+1 to h+1 do

              begin

                if a[k,j]=1 then break;

                if t<=f[k,j] then

                  begin

                    f[k,j]:=t;

                    flag:=true;

                  end;

              end;

          end;

      inc(t);

    until (f[x2,y2]<>max)or (not flag);

    if f[x2,y2]=max then writeln(0)

      else writeln(f[x2,y2]);

end;

procedure main;

  var

    i,j:longint;

  begin

    readln(y1,x1,y2,x2);

    while not ((x1=0) and (y1=0) and (x2=0) and (y2=0)) do

      begin

        a[x2,y2]:=0;

        bfs;

        a[x2,y2]:=1;

        readln(y1,x1,y2,x2);

      end;

end;

begin

  init;

  main;

end.