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