pascal解八数码难题

来源:学生作业帮助网 编辑:作业帮 时间:2024/05/15 18:42:15
pascal解八数码难题

pascal解八数码难题
pascal解八数码难题

pascal解八数码难题
program ex12;
type
block=array[1..3,1..3]of byte;
rec=record
map:block;
bx,by:byte;
father:longint;
step,point:longint;
end;
const
start:block=((1,4,7),
(0,8,9),
(2,3,6));
finish:block=((0,4,7),
(1,2,9),
(3,8,6));
x:array[1..4]of integer=(-1,0,1,0);
y:array[1..4]of integer=(0,1,0,-1);
w:integer=0;
var
notes:array[1..300000]of rec;
open,close:integer;
procedure getpoint(t:integer);
var
i,j:byte;k:integer;
begin
k:=0;
for i:=1 to 3 do
for j:=1 to 3 do
begin
if(finish[i,j]>0)and(notes[t].map[i,j]finish[i,j])then inc(k)
end;
notes[t].point:=notes[t].step+k;
end;
procedure init;
var
i,j:byte;
begin
with notes[1] do
begin
map:=start;
father:=0;
step:=0;
bx:=2;by:=2;
end;
open:=1;close:=1;
end;
procedure expand;
var
i,j:integer;
xx,yy:byte;
p:block;
function same(const p,q:block):boolean;
var
i,j:byte;
begin
same:=true;
for i:=1 to 3 do
for j:=1 to 3 do
if p[i,j]q[i,j]then
begin
same:=false;exit;
end;
end;
procedure print(t:integer);
var
i,j:byte;
begin
if t1 then print(notes[t].father);
if t>1 then writeln('Step:',notes[t].step)else writeln('Start:');
for i:=1 to 3 do
begin
for j:=1 to 3 do write(notes[t].map[i,j],' ');
writeln;
end;
end;
begin
for i:=1 to 4 do with notes[close] do
begin
xx:=bx+x[i];yy:=by+y[i];
if (xx>0)and(yy>0)and(xx