陕西电梯管理系统下载:高手看看我这个题有什么错误

来源:百度文库 编辑:中科新闻网 时间:2024/05/08 02:22:03
十四数码问题:
一个4X4的方阵,里面放了1——14个数,还有两个空格
一步操作可以把一个数码移导相邻得空格中
请问怎样用最少步骤把任一个初始状态转化为目标状态
我写的程序: 每次运行都有错
program shuma;
type
arr=array [1..4,1..4] of byte;
no=record
map:arr;
father:integer;
point:integer;
step:integer;
bx,by:array [1..2] of byte;
end;
const
un:arr=((1,4,0,6),(0,12,7,13),(8,2,11,3),(9,14,5,10));
fi:arr=((13,12,2,3),(14,1,11,4),(8,9,5,0),(7,6,10,0));
x:array [1..4] of shortint=(1,0,-1,0);
y:array [1..4] of shortint=(0,1,0,-1);
var
notes:array [1..1000] of no;
op,cl:integer;
procedure getpoint(n:integer);
var
i,j,p:integer;
begin
for i:=1 to 4 do
for j:=1 to 4 do
if (notes[n].map[i,j]=fi[i,j]) and (notes[n].map[i,j]<>0) then inc(p);
notes[n].point:=p;
end;
procedure load;
begin
with notes[1] do
begin
map:=un;
father:=1;
step:=0;
bx[1]:=1; bx[2]:=2;
by[1]:=3; by[2]:=1;
end;
op:=1; cl:=1;
end;
procedure print(n:integer);
var
i,j:integer;
begin
if n>1 then begin
print(notes[n].father);
writeln(notes[n].step);
writeln;
end;
if n>=1 then begin
for i:=1 to 4 do
begin
for i:=1 to 4 do
if notes[n].map[i,j]<>0 then write(notes[n].map[i,j],' ')
else write(' ');
writeln;
end;
end;
end;
procedure expend;
var
i,j,xx,yy,m,n:integer;

function same(p,q:arr):boolean;
var i,j:integer;
begin
same:=true;
for i:=1 to 4 do
for j:=1 to 4 do
if p[i,j]=q[i,j] then begin same:=false; exit end;
end;
begin
for i:=1 to 2 do
for j:=1 to 4 do
with notes[cl] do
begin
xx:=bx[i]+x[j]; yy:=by[i]+y[j];
if (xx>0) and (xx<5) and (yy>0) and (yy<5) then
begin
m:=bx[i];n:=by[i];
inc(op); if op>1001 then break;
notes[op].map[m,n]:=notes[op].map[xx,yy];
notes[op].map[xx,yy]:=0;
notes[op].father:=cl;
notes[op].step:=step+1;
notes[op].bx[i]:=xx; notes[op].by[i]:=yy;
getpoint(op);
if same(notes[op].map,fi) then
begin
print(op);
close(output);
halt;
end;
for i:=1 to op-1 do
if same(notes[op].map,notes[i].map) then begin dec(op); break; end;
end;
end;
end;
procedure chose;
var
a:no;
i,j:integer;
begin
i:=cl;
for j:=cl+1 to op do
if notes[i].point<notes[j].point then i:=j;
a:=notes[i]; notes[i]:=notes[cl]; notes[cl]:=a;
end;
begin
assign(output,'d:\2.out');
rewrite(output);
load;
repeat
expend;
inc(cl);
chose;
until cl>op;
writeln('no answer');
close(output);
end.