(pascal)八数码问题 双搜

我做的八数码问题为什么双搜算法反而比单搜效率低？请高手帮我看看，谢谢。

输入样例：（前3行、后3行分别是始末状态）

2 3 5
1 4 0
8 7 6
1 2 3
8 0 4
7 6 5

双搜程序：

program num8ss;
type
sz1=array [1..3,1..3] of integer;
sz2=array [1..9] of byte;
rec=record
num:sz1;
step:integer;
end;
const
listmax=100000;
jc:array [0..9] of longint=(1,1,2,6,24,120,720,5040,40320,362880);
dirx:array [1..4] of integer=(1,-1,0,0);
diry:array [1..4] of integer=(0,0,1,-1);
var
start,temp,finish:sz1;
data:sz2;
pc1,pc2:array [0..362879] of boolean;
step1,step2:array [0..362879] of integer;
list1,list2:array [0..listmax] of rec;
front1,front2,rear1,rear2,kt:longint;

procedure change(s:sz1);
var
i,j:integer;
begin
for i:=1 to 3 do
for j:=1 to 3 do
data[(i-1)*3+j]:=s[i,j];
end;

procedure copy(s:sz1);
var
i,j:integer;
begin
for i:=1 to 3 do
for j:=1 to 3 do
temp[i,j]:=s[i,j];
end;

function cantor(s:sz1):longint;
var
i,j,t:integer;
num:longint;
begin
change(s);
num:=0;
for i:=1 to 8 do
begin
t:=0;
for j:=i+1 to 9 do
if data[j]<data[i] then
inc(t);
num:=num+jc[9-i]*t;
end;
cantor:=num;
end;

procedure init;
var
i,j:integer;
k:longint;
begin
for i:=1 to 3 do
for j:=1 to 3 do
read(start[i,j]);
for i:=1 to 3 do
for j:=1 to 3 do
read(finish[i,j]);
for k:=1 to jc[9]-1 do
begin
pc1[k]:=true;
pc2[k]:=true;
end;
front1:=0;
front2:=0;
rear1:=0;
rear2:=0;
end;

function youjie:boolean;
var
s1,s2,i,j:byte;
begin
s1:=0;
s2:=0;
change(start);
for i:=2 to 9 do
if data[i]<>0 then
for j:=1 to i-1 do
if (data[j]<>0) and (data[j]<data[i]) then
inc(s1);
change(finish);
for i:=2 to 9 do
if data[i]<>0 then
for j:=1 to i-1 do
if (data[j]<>0) and (data[j]<data[i]) then
inc(s2);
if (s1-s2)mod 2=0 then
youjie:=true
else
youjie:=false;
end;

procedure insert1(s:sz1);
var
i,j:byte;
begin
for i:=1 to 3 do
for j:=1 to 3 do
list1[rear1].num[i,j]:=s[i,j];
list1[rear1].step:=list1[front1].step+1;
step1[kt]:=list1[front1].step+1;
rear1:=(rear1+1)mod listmax;
end;

procedure insert2(s:sz1);
var
i,j:byte;
begin
for i:=1 to 3 do
for j:=1 to 3 do
list2[rear2].num[i,j]:=s[i,j];
list2[rear2].step:=list2[front2].step+1;
step2[kt]:=list2[front2].step+1;
rear2:=(rear2+1)mod listmax;
end;

procedure proc;
var
i,j,dir:byte;
kt1,kt2:longint;
begin
kt1:=cantor(start);
kt2:=cantor(finish);
if kt1=kt2 then
writeln(0)
else
begin
for i:=1 to 3 do
for j:=1 to 3 do
list1[rear1].num[i,j]:=start[i,j];
list1[rear1].step:=0;
step1[kt1]:=0;
inc(rear1);
pc1[cantor(start)]:=false;
for i:=1 to 3 do
for j:=1 to 3 do
list2[rear2].num[i,j]:=finish[i,j];
list2[rear2].step:=0;
step2[kt2]:=0;
inc(rear2);
pc2[cantor(finish)]:=false;
repeat
for dir:=1 to 4 do
begin
copy(list1[front1].num);
i:=1;
j:=1;
while temp[i,j]<>0 do
begin
inc(j);
if j>3 then
begin
inc(i);
j:=1;
end;
end;
if (i+dirx[dir]>=1) and (i+dirx[dir]<=3) and (j+diry[dir]>=1) and (j+diry[dir]<=3) then
begin
temp[i,j]:=temp[i+dirx[dir],j+diry[dir]];
temp[i+dirx[dir],j+diry[dir]]:=0;
kt:=cantor(temp);
if pc1[kt] then
begin
insert1(temp);
if not pc2[kt] then
begin
writeln(step1[kt]+step2[kt]);
exit;
end;
end
end;
end;
front1:=(front1+1)mod listmax;
for dir:=1 to 4 do
begin
copy(list2[front2].num);
i:=1;
j:=1;
while temp[i,j]<>0 do
begin
inc(j);
if j>3 then
begin
inc(i);
j:=1;
end;
end;
if (i+dirx[dir]>=1) and (i+dirx[dir]<=3) and (j+diry[dir]>=1) and (j+diry[dir]<=3) then
begin
temp[i,j]:=temp[i+dirx[dir],j+diry[dir]];
temp[i+dirx[dir],j+diry[dir]]:=0;
kt:=cantor(temp);
if pc2[kt] then
begin
insert2(temp);
if not pc1[kt] then
begin
writeln(step1[kt]+step2[kt]);
exit;
end;
end
end;
end;
front2:=(front2+1)mod listmax;
until false;
end;
end;

begin
assign(input,'num8ssin.txt');
reset(input);
init;
if youjie then
proc
else
writeln('No Answer!');
close(input);
end.

program num8_str1；
uses Crt；
type a33：array[1..3，1..3] Of byte；
{3X3的二维数组，用于存放棋盘布局}
a4=array[1..4] of shortint;
node=record {定义数据库中每个元素记录类型结构}
ch: a33;
si, sj: byte;
pnt, dep: byte;
end;
const goal:a33 = ((1,2,3), (8,0,4), (7,6,5)); {目标布局}
start:a33 =((2,8,3), (1,6,4), (7,0,5)); {初始布局}
di:a4=(0,-1, 0, 1);
dj:a4=(-1, 0, 1, 0);
var data:array[1..100] of node;
temp: node;
r, k, ni, nj, Head, Tail, depth: integer;
{变量depth存放当前搜索深度}
function check(k: integer) :boolean; { 检查某步移动是否可行}
begin
hi:=temp.si+di[k] ; nj:=temp.sj+dj[k];
if (ni in [1..3]) and (nj in [1..3]) {~移动后新位置仍在棋盘中}
then check:=true else check:= false;
end;
function dupe: boolean; { 检查队尾新存入布局是否已在队列中存在}
var i,j, k: integer;
buf:boolean;
Begin
buf:= false; i: = 0;
{变量将i依次指向队列中的各个布局(最后一个除外)的位置}
repeat
inc(i) ;buf:= true;
for j:=1 to 3 do
for k:=1 to 3 do
if data[i].ch[j,k] < >data[tail].ch[j,k]
{data[tail]是队列中最后一个元素，即新产生的布局}
then bur:= false;
until buf or (i> = tail-1);
{buf=truee新布局与队列中布局有重复}
dupe:= buf
end;
function goals: boolean; { 比较是否达到目标布局状态}
var i,j :byte;
begin
goals:= true;
for i:=1 to 3 do
for j:=1 to 3 do
if data[tail].ch[i,j] < >goa1[i,j]
then goals:=false {未达到目标布局}
end;
procedure trace;
var i,j :byte;
begin
write( 'cl=', Head,' op=', tail);
writeln('dep=',depth,'k=',k);
fori:=1 to 3 do
begin
for j:= 1 to 3 do write(data[tail], ch[i,j]);
writeln end;
end;
procedure print; {输出移动步骤}
var buf: array[1..100] of integer;
{数组buf存放起始态、目标态以及从起始态到目标态所经过的各态的位置}
i,j, k, n: integer;
begin
n:= 1;
i:= tail;buf[1]:= i; {buf[1]中是目标布局在队列中位置}
repeat
j:=data[i].pnt; {data[I].pnt的值是布局I的父结点的位置}
inc(n); buf[n]:=j; i:=j
until i=0; {根结点(初态)的父结点为0，即I=0}
writeln(' staps:', depth + 1);
for i:= 1 to 3 do {打印棋盘布局}
begin
for k:=n-1 down to 1 do
begin
for j:= 1 to 3 do write(data[buf[k]].ch[i,j]);
if i = 2 then write( ' - > ') else write(' ');
end;
writeln;
end;
readln; halt
end;
{ main program = }
begin
Head:= 0; tail:= 1;
with data[1] do {队列中存入第一个元素(初始状态)}
begin ch:= start; si:= 3; sj:= 2;
pnt:= 0; dep:= 0;
end;
repeat
inc(Head);temp:=data[Head]; {取队首记录}
depth:= temp.dep;
for r:= 1 to 4 do {对取出记录进行扩展}
if check(r) then {布局中空格向某方向移动成功}
begin
inc(tail);data[tail]:= temp; {新产生布局存入队尾}
with data[tail] do
begin ch[si,si]:= ch[nj,nj];
ch[ni,nj]:=0;si:=nj;si:=nj;
pnt:=Head;{记录此布局的上一布局在队列中的位置}
dep:= depth + 1;{记录本布局的搜索深度}
end;
trace;
if dupe then dec(tail) {dec(tail删除新产生的结点)}
else if goals then print;
end;
until Head>=tail; {队列空}
writeln('no solution');readln
end