双向广度优先搜索
广度优先搜索遵循从初始结点开始一层层扩展直到找到目标结点的搜索规则，它只能较好地解决状态不是太多的情况，承受力很有限。如果扩展结点较多，而目标结点又处在较深层，采用前文叙述的广度搜索解题，搜索量巨大是可想而知的，往往就会出现内存空间不够用的情况。双向搜索和A算法对广度优先的搜索方式进行了改良或改造，加入了一定的“智能因素”，使搜索能尽快接近目标结点，减少了在空间和时间上的复杂度。
(1)搜索过程
有些问题按照广度优先搜索法则扩展结点的规则，既适合顺序，也适合逆序，于是我们考虑在寻找目标结点或路径的搜索过程中，初始结点向目标结点和目标结点向初始结点同时进行扩展—，直至在两个扩展方向上出现同一个子结点，搜索结束，这就是双向搜索过程。出现的这个同一子结点，我们称为相交点，如果确实存在一条从初始结点到目标结点的最佳路径，那么按双向搜索进行搜索必然会在某层出现“相交”，即有相交点，初始结点一相交点一目标结点所形成的一条路径即是所求路径。
例如：移动一个只含字母A和B的字符串中的字母，给定初始状态为(a)表，目标状态为(b)表，给定移动规则为：只能互相对换相邻字母。请找出一条移动最少步数的办法。
[AABBAA] [BAAAAB]
(a) (b)
解题分析
：从初始状态和目标状态均按照深度优先搜索扩展结点，当达到以下状态时，出现相交点，如图1(a)，结点序号表示结点生成顺序。
双向扩展结点：
顺序 逆序
1 1
___AABBAA___ BAAAAB
2 / / 3 2 / / 3
__ABABAA__ AABABA ABAAAB BAAABA
4 / |5 / 6 7 / / 8 4 /
ABBAAA BAABAA ABAABA AAABBA AABAAB AABAAB
(a) 图1 (b)
顺序扩展的第8个子结点与逆序扩展得到的第4个子结点就是相交点，问题的最佳路径如图2。
[AABBAA]—[AABABA]—[AABAAB]—[ABAAAB]—[BAAAAB]
图2
从搜索的结点来看，双向广度要简单得多。假设每一个子结点可以扩展的子结点数是X，不计约束条件，以完全X叉树计算，那么用广度优先搜索一个长度为I的最佳路径的解，共需要扩展结点X(XL-1)÷(X-1)。从双向搜索来看，设正个方向的搜索在第y层找到向交点，那么正向共搜索了X(XY-1)÷(X-1)，逆向扩展的结点数为(XL-y-1)÷(X-1)，两个方向共搜索了 X(XY+XL-Y-2)÷(X-1)。我们假设L为偶数，则Y=L/2，双向搜索扩展的结点数约为单向搜索的2÷(XL/2+1)*100％，相对减少(XL/2-1)÷(XL/2+1)*100％。
当然这里只是作个粗略的比较，事实上在其它一般情况下，双向搜索搜索量都要比单向搜索来的少。
(2)结点扩展顺序
双向扩展结点，在两个方向的扩展顺序上，可以轮流交替进行，但由于大部分的解答树并不是棵完全树，在扩展完一层后，下一层则选择结点个数较少的那个方向先扩展，可以克服两个方向结点生成速度不平衡的状态，明显提高搜索效率。
(3)数据结构
单向广度优先搜索需建立两个表OPEN和CLOSED，用来存储生成结点和已扩展结点，双向搜索从两个方向进行扩展，我们建立两个二维表OPEN，CLOSED，OPEN[1]，CLOSED[1]， OPEN[2]，CLOSED[2]分别存储两个方向上的生成结点和已扩展结点，OPEN仍然是具有“先进先出”的队列结构。为编程方便，我们采用基于广度优先搜索算法的双向，建立三个二维指针：Q1，Q2，Q3其作用如下：
Q1[1]，Q1[2]：分别指向两个方向上当前待扩展层的第一个结点。
Q2[1]，Q2[2]：分别指两个方向上队尾新产生的结点。
Q3[1]，Q3[2]：分别指向两个方向上下一层的第一个结点位置。
为了区分当前搜索方向，设方向标志：
t=1表示处于正向搜索，t=2表示处于逆向搜索。
Fail—有一个方向搜索失败时，为真，并且结束搜索过程，否则为假。
I—全局变量，指向当前要扩展的结点。
(4)算法描述
Program DOUBFS；
初始化，初始结点，和目标结点分别进入OPEN[1]和OPEN[2]表；
Q1[1]:=1;Q2[1]:=1;Q1[2]:=1;Q2[2]:=1；
repeat
if (Q2[1]-Q1[1])<=(Q2[2]-Q1[2]) then t:=1
else t:=2；
for I:=Q1[t] to Q2[t] do
EXPEND(t)；{扩展第1个结点}
Q1[t]:=Q3[t]；
until(Q1[t]>Q2[t])；
其中过程EXPEND(t)的结构如下：
Procedure expand(t：integer)；
Var j：integer；
begin
for j:=1 to n do {n为最多后继状态数}
begin
产生i点的第j个后继状态，将它加入到队尾(Q2[t]+1)；
if新结点未与其上一层以上的所有点重复
then if isans(t) then [输出解；halt；] else
else将新点从队列中去掉；(Q2[t]-1)
end； -
end；
判断是否是相交点的过程isans(t)如下：
function isans(t：integer)：Boolean；
var j，t1：integer；
begin
if t=1 then t1:=2 else t1:=1；
isans:=false；
forj:=Q1[t1] to Q2[t1] do
if Q2[t]=j {Q2[t]新结点是相交点}
then [isans:=true；exit]；
end；
(5)例题应用
【例1】魔方问题
在魔方风靡全球之后，Rubik先生发明了它的简化版——魔板。魔板由8个同样大小的方块组成，每个方块的颜色均不相同，本题中以数字1—8分别表示，可能出现在魔板的任一位置，任一时刻魔板的状态可以用方块的颜色序列表示：从魔板的左上角开始，按顺时针方向依次写下各方块的颜色代号，得到的数字序列即可表示此时魔板的状态。
例如，序列(1，2，3，4，5，6，7，8)表示题中魔板的初始状态。
1 2 3 4
8 7 6 5
对于魔板，可以施加三种不同的操作，分别以A，B，C标识。
具体操作方法如下：
A：上下行互换，如上图可以变换为状态87654321
B：每行同时循环右移一格，如上图可以变换为41236785
C：中间4个方块顺时针旋转一格，上图可以变换为17245368。
应用这三种基本操作，可以由任一状态达到任意另一状态。
子任务A：
请编一程序，对于输入的一个目标状态，寻找一种操作的序列，使得从初始状态开始，经过此操作序列后使该魔板变为目标状态。
子任务B：
如果你的程序寻找到的操作序列在300步以内，会得到子任务B的分数。
输入数据：
文件名INPUT．TXT，第一行包含8个以一个空格相隔的正整数，表示目标状态。
输出数据：
输出文件名为OUTPUT．TXT，在第一行输出你的程序寻找到的操作序列的步数L，随后L行是相应的操作序列，每行的行首写一个字符，代表相应的操作。
【算法分析】
A．空间复杂度如果解的步数为n，则状态表示空间约占3
n
。
B．基本算法本题是典型的广度优先算法题，很自然的想到能否构造启发算法。但本题不同于八数码，很难找到一个估价函数。因为每一种状态的达到都有三种本质不同的方法，因此在计算某一状态的估价值时，容易将状态各个数字的最少移动步数重复计算，或忽略计算，不能够构造出一个恰当函数f*使得f*< f。因此不宜采用启发算法得出最优解，而只能得可行解。现在考虑双向广度优先搜索。
双向搜索与单向广度搜索相比的优点在于节省了存储空间，避免搜索出更多的无用结点，提高丁搜索速度，如果采用动态数组存储(655 350Byte)可以做到大约21～22步，甚至可以更多。
【参考程序】
Program Rubic；
Uses Crt;
Const
n=8;
input = 'input.txt';
Type
dar = record
f: integer;
d: array[1..n] of Integer;
End;
Var
Cab: array[1..2,1..7500] of ^dat;
dat1,dat2: dat;
Procedure Init;
Var
f: text;
i,i: Integer;
Begin
assign(f, input);
reset(f);
new(cab[1,1]);
for I:=1 To n do
read(f,cab[1,I]^.d[i]);
cab[1,1]^.f := 0;
readln(f);
new(cab[2,1 ] );
for I := 1 tondo
read(f,cab[2,1]^.d[i]);
readln(f);
cab[2,1]^.f := 0;
End;
Function Check(x,y: Integer) :boolean;
Var
i,j,k: Integer;
ok: Boolean;
Begin
for i:= 1 to y-1 do
Begin
forj := 1 to n do
if cab[x,i]^.d[j] < > dat1.d[j] then
Begin
ok := true;
Break;
End else Ok:= false;
if not ok then break;
End;
Check := ok;
End;
Function CheckOut(X,Y: Integer;Var a: Integer): Boolean;
Var
i,j,k: Integer;
ok: Boolean;
Begin
a:=0;
fori := 1 to y do
Begin
for j := 1 to n do
if cab[x,i]A.d[j] < > dat1.d[j] then
Begin
ok := true;
Break;
End else Ok: = false;
if not ok then
Begin
a:= i;
break;
End;
End;
CheckOut := ok;
End;
Procedure Print(a,b,c: Integer);
Var
i,j,k,l: Integer;
s1,s2: array[1..30] of Integer;
x,y: Integer;
Begin
fillchar(s1,sizeof(s1), 0);
fillchar(s2,sizeof(s2) ,0);
if a = 1 then
Begin
i:=1;
j:=2;
End else
Begin
i:=2;
j:=1;
End;
k:= O;
Repeat
inc(k);
s1[k] := b;
b := cab[i,b]^.f;
Until b = 0;
l:= 0;
Repeat
inc(l);
s2[l] := c;
c := cab[j,c]^.f;
Until c = 0;
if a = 1 then
begin
for x := k downto 1 do
Begin
for y := 1 to n do
write(cab[1,s1[x]]^.d[y]: 3);
if y mod 4 = 0 then writeln;
End;
writeln('-----');
Readln;
End;
for x := 2 to l do
Begin
for y := 1 to n do
Begin
write(cab[2,s2[x]]^.d[y]: 3);
if y mod 4 = 0 then writdn;
End;
writeln('-----');
Readln;
End;
End
else
Begin
for x := l downto 1 do
Begin
for y := 1 to n do
write(cah[1,s2[x]]^.d[y]: 3);
if y mod 4 = 0 then writdn;
End;
writeln('-----');
Readln;
End;
for x := 2 to k do
Begin
for y:= 1 to n do
begin
write(cab[2,s1[x]]^.d[y]: 3);
if y mod 4 = 0 then writeln;
End;
writeln('-----');
Readln;
End;
End;
Halt;
End;
Procedure Double;
Var
i,j: array[1..2] of Integer;
Out: Boolean;
k,l,kk,s: Integer;
i[1] := 1;
i[2] := 1;
j[1] := 2;
j[2] := 2;
Out := false;
repeat
kk:=2;
k:=1;
{--1--}
dat1.d := Cab[k,i[k]]^.d;
for l := 1 to 4 do
Begin
dat1.d[l] := dat1.d[l+4];
dat1.d[l+4] := cab[k,i[k]]^.d[l];
End;
dat1.f := i[k];
if Check(k,j[k]) then
Begin
new(mb[kd[k]]);
mb[kd[k]]^:= dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk] - 1,s) then Print(k,j[k] - 1 ,s);
End;
{--2--}
dat1.d := Cab[k,i[k]]^.d;
dat1.d[3]: = dat1.d[2];
dat1.d[2] := dat1.d[5];
dat1.d[5] := dat1.d[6];
dat1.d[6] := cab[k,i[k]]^.d[3];
dat1.f: = i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^ := dat1;
inc(j[k]);
if NOt CheckOut(kk,j[kk] - 1,s) then Print(k,j[k] - 1,s);
End;
{--3--}
dat1.d:= Cab[k,i[k] ]^.d;
dat1.d[4]: = dat1.d[3];
dat1.d[3]: = dat1.dj2];
dat1.d[2] := dat1.d[1];
dat1.dj1] := cab[k,i[k]]^.d[4];
dat1.f := i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^:= dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk]- 1,s) then Print(k,j[k] - 1,s);
End;
Inc(i[k]);
kk:= 1;
k:=2;
{--1--}
dat1.d := Cab[k,i[k]]^.d;
for l := 1 to 4 do
Begin
dat1.d[l] := dat1.d[l+4];
dat1.d[l+4] := cab[k,i[k]]^.d[l];
End;
dat1.f:= i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k] ]);
cab[k,j[k]]^:= dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk] - 1 ,s) then Print(k,j[k] - 1 ,s);
End;
{--2--}
dat1.d := Cab[k,i[k]]^.d;
daft. d[2] : = dat1. d[3];
dat1.d[3] := dat1.d[6];
dat1.d[6]: = dat1.d[5];
dat1.d[5] := cab[k,i[k]]^.d[2];
dat1.f: = i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^:= dat1;
ine(j[k]);
if Not CheckOut(kk,j[kk] - 1 ,s) then Print(k,j[k] - 1 ,s);
End;
{---3---}
dad.d:= Cab[k,i[k]]^.d;
dat1.d[1] := dat1.d[2];
dat1.d[2] := dat1.d[3];
dat1.d[3] := dat1. d[4];
dat1.dj4] := cab[k,i[k] ]^.d[1];
dat1.f := i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^ := dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk] - 1,s) then Prim(k,j[k] - 1,s);
End;
Inc(i[k]);
until Out;
End;
Begin
INit;
clrscr;
Double;
End．
