广度优先搜索
在深度优先搜索算法中，深度越大的结点越先得到扩展。若把它改为深度越小的结点越先得到扩展，就是广度优先搜索法，下面通过一个具体实例来讨论广度优先算法的一般规律。
[例题4-1八数码难题]
在3X3的棋盘上，摆有八个棋子，每个棋子上标有1至8的某一数字。棋盘中留有一个空格。空格周围的棋子可以移到空格中。要求解的问题是：找到一种最少步骤的移动方法，实现从初始布局到目标布局的转变。
例如输入：（代表从前一布局到后一布局）
2 8 3
1 6 4
7 0 5
1 2 3
8 0 4
7 6 5
[分析]
由于题目要找到的解是达到目标最少步骤，因此解题的方法为：从初始状态出发，先把移动一步后的布局全部找到，检查是否达到目标布局；如果没有，再从这些移动一步的布局出发，找到移动两步后的所有布局，再判断是否有达到目标的；如此继续，一直达到目标状态为止，输出结果。由于是按移动步数从少到多产生新布局的，所以找到的第一个目标一定是移动步数最少的一个，也就是最优解。
建立产生式系统。其中：综合数据库显然用3X3的二维数组来表示布局比较直观。用ch(i,j)表示第i行第j列格子上放的棋子数字，空格则用0表示。为了方便编程，还需存储该布局的空格位置：(si,sj)；初始布局到该布局的步数，即深度dep；该布局的上一布局，即父结点的位置。这样数据库每一个元素应该是由上述几个数据组成的记录。
因为新产生的结点深度(也即从初始布局到该结点的步数)一般要比数据库原有结点大(或相等)，按步数大的后扩展的要求，应该放在数据库的后面。而当前扩展的结点从数据库前面选取，即符合先产生的先扩展，后产生的后扩展规律。所以数据库的结构用队列的结构形式较合适。用上述记录为元素的数组data来表示数据库，并设置两个指针：closed为队列的首指针，open为队列的尾指针。
产生规则：原规则规定空格周围的棋子可以向空格移动。但如果换一种角度观察，也可看做空格向四周移动。这样处理更便于编程。如果空格位置在(si,sj)，则有四条规则：
(1)空格向上移动: If si-1>=1 then ch(si,sj):=ch(si-1,sj);ch(si-1,sj):=0
(2)空格向下移动: If si+1<=3 then ch(si,sj):=ch(si+1,sj);ch(si+1,sj):=0
(3)空格向左移动: If sj-1>=1 then ch(si,sj):=ch(si,sj-1);ch(si,sj-1):=0
(4)空格向右移动: If sj+1<=3 then ch(si,sj):=ch(si,sj+1);ch(si,sj+1):=0
用数组Di和Hj来表示移动的行列增量，则有：
R     1     2     3     4
方向     左     上     右     下
Di     0     -1     0     1
Hj     -1     0     1     0
算法设计：
program ex4_1_2;
初始化；把初始布局存入数据库data
设首指针closed:=1；尾指针open:=0
repeat
   open增1，取出队列首纪录为当前被扩展节点；
   for r:=1 to 4 do {r是规则编号}
       begin
       if 新空格位置合法 then
           begin
           closed 增1，把新布局存入队尾
           if 新布局与队列中原有纪录重复 then 删除新产生的布局
          else if 达到目标 then 输出并退出


       end
     end
   until open>=closed{队列空}
[源程序]
{$M 65521,0,655360}
program ex4_1_1;
const
   fn1='ex4_1.in';
   fn2='ex4_1.out';
type
   xtype=array [1..3,1..3] of 0..8;
   ctype=array [1..10000] of ^xtype;
   dtype=array [1..10000] of integer;
var
   a,b:xtype;
   c:ctype;
   dep,father:^dtype;
   x0:array[1..10000,1..2] of byte;
   procedure init;
   var
     f:text;
     i,j:integer;
   begin
     new(dep);new(father);
     for i:=1 to 10000 do new(c[i]);
     assign(f,fn1);reset(f);
     for i:=1 to 3 do begin
       for j:=1 to 3 do read(f,a[i,j]);
       readln(f);
       end;
     readln(f);
     for i:=1 to 3 do begin
       for j:=1 to 3 do read(f,b[i,j]);
       readln(f)
       end;
     close(f);
     end;
   procedure calc;
   var
     i,j,k:integer;
     open,closed:integer;
     d:xtype;
     procedure bool;
     var
       i,j,k,l:integer;
       f:text;
       e:dtype;
     begin
       l:=0;
       for j:=1 to 3 do for k:=1 to 3 do
         if b[j,k]<>c[closed]^[j,k] then l:=1;
       if l=0 then begin
         assign(f,fn2);rewrite(f);
         j:=0;
         repeat
           inc(j);e[j]:=closed;
           closed:=father^[closed];
           until closed=0;
         for k:=j downto 1 do begin
           for i:=1 to 3 do begin
             for j:=1 to 3 do
               write(f,c[e[k]]^[i,j]:3);
             writeln(f)
             end;


           writeln(f)
           end;
         close(f);halt
       end;
     end;
   procedure cheakup;
   var
     i,j,k,l:integer;
   begin
     for i:=1 to closed-1 do begin
       l:=0;
       for j:=1 to 3 do for k:=1 to 3 do
         if c[i]^[j,k]<>c[closed]^[j,k] then l:=1;
       if l=0 then begin dec(closed);exit end
       end;
     bool;
     end;
   begin
     open:=0;closed:=1;
     c[closed]^:=a;dep^[closed]:=0;
     father^[closed]:=0;bool;
     for i:=1 to 3 do for j:=1 to 3 do
       if a[i,j]=0 then begin
         x0[1,1]:=i;x0[1,2]:=j end;
     repeat
       inc(open);
       d:=c[open]^;
       i:=x0[open,1];j:=x0[open,2];k:=dep^[open];
       if i>1 then begin
         inc(closed);c[closed]^:=d;
         c[closed]^[i,j]:=c[closed]^[i-1,j];
         c[closed]^[i-1,j]:=0;
         dep^[closed]:=k+1;father^[closed]:=open;
         x0[closed,1]:=i-1;x0[closed,2]:=j;
         cheakup
         end;
       if i<3 then begin
         inc(closed);c[closed]^:=d;
         c[closed]^[i,j]:=c[closed]^[i+1,j];
         c[closed]^[i+1,j]:=0;
         dep^[closed]:=k+1;father^[closed]:=open;
         x0[closed,1]:=i+1;x0[closed,2]:=j;
         cheakup
         end;
       if j>1 then begin
         inc(closed);c[closed]^:=d;
         c[closed]^[i,j]:=c[closed]^[i,j-1];
         c[closed]^[i,j-1]:=0;
         dep^[closed]:=k+1;father^[closed]:=open;


         x0[closed,1]:=i;x0[closed,2]:=j-1;
         cheakup
         end;
       if j<3 then begin
         inc(closed);c[closed]^:=d;
         c[closed]^[i,j]:=c[closed]^[i,j+1];
         c[closed]^[i,j+1]:=0;
         dep^[closed]:=k+1;father^[closed]:=open;
         x0[closed,1]:=i;x0[closed,2]:=j+1;
         cheakup
         end;
       until (open>=closed) or (closed>=10000);
     end;
   procedure print;
   var
     f:text;
   begin
     assign(f,fn2);rewrite(f);
     writeln(f,'No solution!');close(f)
     end;
begin
   init;calc;print
   end.
程序运行结果为：
第一步     第二步     第三步     第四步     第五步     第六步
283     283     203     023     123     123
164     104     184     184     084     804
705     765     765     765     765     765
程序先产生深度为1结点，在产生深度为2的结点，最后产生目标深度为5的结点。先横向扩展，再纵向深入。由此，我们可以得到广度优先的基本算法：
program   BFS;
初始化；把初始布局存入数据库data
设首指针closed:=1；尾指针open:=0
repeat
   open增1，取出open所指结点进行扩展；
   for r:=1 to max do {r为产生规则编号}
       begin
       if 子结点符合条件 then
           begin
           closed 增1，把新接点存入数据库队尾
           if 新结点与原结点重复 then 删除新结点(closed减1)
          else if 新结点即目标 then 输出并退出
       end
     end
   until open>=closed{队列空}。
不同的问题，用广度优先搜索的基本算法是一样的。但数据库的表示方法、产生的结点是否符合条件和重复的判断上可以有不同的编程技巧，程序的运行效率也大不一样。
如8数码问题，用字符串表示布局，则初始布局为“283164705”，目标布局为“123804765”产生规则为：


空格上移：空格位置减3，即交换Si和Si-3的字符；
空格左移：空格位置减1，即交换Si和Si-1的字符；
空格右移：空格位置加1，即交换Si和Si+1的字符；
空格下移：空格位置
加3
，即交换Si和Si
+3
的字符。
即：如空格编号为K，则交换Si和Si+(2*k-5)的字符。
大家可以自己编写程序，比较一下效率。（请大家找一下用二维数组表示布局的优缺点，答案见key）。
[例题4-9翻币问题]
[问题描述]
有N个硬币(N≥6)正面朝上排成一排，每次将5个硬币翻过来放在原位置，直到最后全部硬币翻成反面朝上为止。
1、用计算机求最少需要翻几次。
2、找出部数最少的翻币方法，把翻币过程及次数打印出来(用O表示正面，＊表示反面)。
[分析]
由于问题要求找出最少步骤，用广度优先搜索法来求解。
表面看，翻币的过程与正反面硬币的排列位置有关，但只要经过仔细分析会发现：实际上翻币过程仅与硬币正反面的个数有关，与它们的位置是无关的。例如下面两种状态：
O ＊ Ｏ ＊ Ｏ ＊ Ｏ Ｏ和＊ ＊ ＊ Ｏ Ｏ Ｏ
都只要把5个正面朝上的硬币翻过来就达到了目标。因此在搜索过程中只需考虑当前状态正面朝上的个数。
又如，如果当前状态是：       ＊   ＊   ＊   Ｏ   Ｏ   ＊   ＊   ＊
翻第1，2，4，6，8个得到：   O    O   ＊   ＊   O    O   ＊   O
而翻第3，5，6，7，8个得到：＊   ＊   Ｏ   Ｏ   ＊   Ｏ   Ｏ   Ｏ
这两种翻法虽翻的硬币不同，但都是把原状态中4个反面朝上、1个正面朝上的硬币翻过来。结果状态不同，但都有5个硬币正面朝上，再翻一次就都可以达到目标。所以产生规则也只需考虑翻正面朝上的硬币的个数不同就可以了。
建立产生式系统。其中：综合数据库。综合数据库中每个记录设计为三项：父结点位置，当前状态中硬币正面朝上的个数，由父结点翻了几个正面朝上的硬币得到当前状态。数据库本身用队列形式。
产生规则如下：
M：正面朝上的硬币个数
R：翻R个正面朝上的硬币：
IF当前结点正面朝上的硬币个数M≥R且反面朝上的个数≥5—R THEN
子节点正面朝上的硬币的个数=（M-R）+（5-R）
[源程序]
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
{ $ M 65521, 0, 655360}
program ex4_9;
var
n: integer;
a: array [1..8000,1..3] of integer;
b: array [0..8000] of boolean;
procedure calc;
var
   r, m: integer;
   open, closed: integer;
  
   procedure print;
     var
       i, j, k,l, h: integer;
       d : array [ 1..5000] of integer;
       st: array [ 1..5000] of char;
       begin
         write ('step    0:');for i:=1 to n do write ('o'); writeln;
         for i:=1 to n do st[i]:='o';j:=0; i:=closed;
         repeat
            j:=j+1; d[j]:=i;i:=a [i,1];
         until i=0;


         for i:=j-1 downto 1 do begin
             k:=a[d[i],3];l:=5-k;
             for h:=1 to n do
               if st[h]='o' then begin
                   if k>0 then begin dec(k);st[h]:='*' end
                   end
               else begin
                   if l>0 then begin dec(l); st[h]:='o' end
                   end;
             write('step',j-i:4,':');for h:=1 to n do write(st[h]);
             writeln;
             end;
         exit;
         end;
   begin
     fillchar(b,sizeof(b),true);b[n]:=false;
     open:=0;closed:=1;a[1,1]:=0;a[1,2]:=n;a[1,3]:=0;
     repeat
       inc(open); m:=a[open, 2];
       for r:=0 to 5 do
         if (m>=r) and (n-m>=5-r) and (b[m-r+5-r])then begin
           inc(closed);b[m-r+5-r]:=false;
           a[closed,1]:=open;
           a[closed, 2]:=m-r+5-r;
           a[closed,3]:=r;
           if a[closed,2]=0 then begin print;exit;end;
           end;
       until open>=closed;
       writeln (' No answer!');
    end;
begin
    write('Input n(n>=6):'); readln(n);
    while n>=6 do begin
    if n<6 then writeln ('Input error!' ) else calc;
    write('Input n(n>=6):'); readln(n);
    end;
end.
[例题4-10]
[问题描述]
有两个无刻度标志的水壶，分别可装x升和y升(x、y为整数，x、y<-100)的水。设另有一水缸，可用来向水壶灌水或倒出水，两水壶间，水也可以相互倾灌。已知x升壶为满壶，y升壶为空壶。问如何通过倒水或灌水操作，用最少步数能在y升壶中量出z(z<-100)升的水来。


[分析]
本题要求最少步数，显然应采用广度优先搜索。
设A水壶内有a升水，B水壶内有b升水，则最多会有六种产生规则：
(1)当a>0且b<y时，可以从水壶A倒min (a，y-b)升水给水壶B。这时水壶A内有a-min(a，y-b)升水；水壶B内有b+min(a,y-b)；
(2)当b>0且a<x时，可以从水壶B倒min(b，x-a)升水给水壶A。这时水壶A内有a+min(b，x-a)升水；水壶B内有b+min(b，x-a)升水；
(3)当a>0时，可以从水壶A倒a升水给水缸。这时水壶A内有0升水。
(4)当a<x时，可以从水缸倒x-a升水给水壶A。这时水壶A内有x升水。
(5)当b>0时，可以从水壶B倒b升水给水缸，水壶B内有0升水。
(6)当b<y时，可以从水缸倒y-b升水给水壶B，水壶B内有y升水。
初始状态：水壶A内有x升水，水壶B内有0升水。
数据结构：
atype=record
      father,a,b:word;
      end;
data[1..10000] of atype
(father：当前节点的父节点编号；a，b：当前状态中水壶A,B里各有水多少？)
[源程序]
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
{$M 65521,0,655360}
program ex4_10;
type
   atype=record father,a,b:word;end;
   btype=array [0..100,0..100] of boolean;
var
   x,y,z:word;
   data:array [1..10000] of atype;
   bool:^btype;
   procedure calc;
   var
     i,j,k,l:word;
     open,closed:integer;
     function min(a,b:word):word;
     begin
       if a<b then min:=a else min:=b
       end;
     procedure print;
     var
       i,j:integer;
       d:array [1..10000] of integer;
     begin
       j:=0;i:=closed;
       repeat j:=j+1;d[j]:=i;i:=data[i].father until i=0;
       for i:=j downto 1 do
         writeln('setp ',j-i:3,':',data[d[i]].a:5,data[d[i]].b:5);
         readln;halt;
       end;
     procedure evaluate (i, j: word);
     begin
       bool^[i,j]:=false;inc(closed);
       data[closed].a:=i;data[closed].b:=j;
       data[closed].father:=open;
       if j=z then print
       end;
   begin
     new (bool); fillchar(bool^, sizeof (bool^) ,true);
     open:=0; closed:=1;bool^[x,0]:=false;
     data[1].a:=x;data[1].b:=0;data[1].father:=0;
     if (z=x) or (z=0) then print;
     repeat
       inc(open);i:=data[open].a;j:=data[open].b;


   begin
     assign(f,fn2);
     rewrite(f);
     writeln(f,total);
     writeln(f,max);
     writeln(f,'(',x1,',',x2,')','(',x3,',',x4,')');
     close(f)
     end;
   procedure calc1;
   var
     i,j,k,x,y:integer;
     open,closed:integer;
   begin
     fillchar(b,sizeof(b),0);
     fillchar(area,sizeof(area),0);
     total:=0;i:=1;j:=0;
     repeat
       inc(total);
       repeat
         inc(j);
         if j>m then begin
           j:=1;inc(i)
           end
         until (i>n) or (b[i,j]=0);
       if i>n then exit;
       fillchar(list,sizeof(list),0);
       list[1,1]:=i;
       list[1,2]:=j;
       b[i,j]:=total;
       area[total]:=1;
       open:=0;
       closed:=1;
       repeat
         inc(open);
         x:=list[open,1];
         y:=list[open,2];
         for k:=0 to 3 do
         if a[x,y,k] and (b[x+way[k,1],y+way[k,2]]=0) then
           begin
           inc(closed);inc(area[total]);
           list[closed,1]:=x+way[k,1];
           list[closed,2]:=y+way[k,2];
           b[list[closed,1],list[closed,2]]:=total
           end
         until open>=closed
       until false
     end;
   procedure calc2;
   var
     i,j:integer;
     newmax:integer;
     procedure evaluate(k,l:integer);
     begin      if(b[i,j]<>b[k,1])and(area[b[i,j]]+area[b[k,1]]>newmax)then
         begin
         newmax:=area[b[i,j]]+area[b[k,l]];
         x1:=i;x2:=j;x3:=k;x4:=1
         end
       end;
   begin
     dec(total);max:=0;newmax:=0;
     for i:=1 to total do
       if area[i]>max then max:=area[i];
       for i:=1 to n-1 do
         for j:=1 to m do evaluate(i+1,j);
       for i:=1 to n do
         for j:=1 to m-1 do evaluate(i,j+1);
     end;
   procedure main;
   begin
     calc1;
     calc2
     end;
begin
   init;
   main;
   print
end.


很不错

LZ到底想说明神马- -？

LZ很好很强大……

有注释会更好