-
Giúp mình Sủa Bài này với.
trong bài này cho n= 3.bây giờ mình muốn thay n=5 .Bác nào pro giúp với mình dốt pascal lắm
program tri_teu_nhan_tao_1;
uses crt;
const MAX=9;m=12;so=3;CT=1000;
type
state =array[1..MAX] of integer;
ptr =^node;
node =record
tang :integer;
value : integer;
st :state;
child : ptr;
nextsibling : ptr;
parent : ptr;
end;
vector = record
x,y:integer;
end;
var
start [IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
qu,l,ketqua :array [1..CT] of ptr;
movetable :array [1..m] of vector;
d,top,luu,kq :integer;
state_finish :state;
f :text;
procedure khoitao;
var i,j:integer;
f1 : text;
begin
assign (f1,'ttnt11.dat');
reset(f1);
for i:= 1 to m do
begin
read (f1,movetable.x);
read (f1,movetable.y);
readln (f1);
end;
close (f1);
new(start);
assign (f1,'ttnt12.dat');
reset (f1);
for i :=1 to so do
begin
for j:= 1 to so do
read (f1,start^.st[(i-1)*so+j]);
readln (f1);
end;
close (f1);
assign (f1,'ttnt13.dat');
reset(f1);
for i:=1 to so do
begin
for j:= 1 to so do
read (f1,state_finish[(i-1)*so+j]);
readln(f1);
end;
close (f1);
end;
function
moveable (t:vector;tt:state):integer;
begin
if ((tt[t.x]=0) and (tt[t.y]<>0) and (t.x=t.y-1))
then moveable :=2
else if ((tt[t.x]<>0) and (tt[t.y]<>0) and (t.x=t.y-so))
then moveable:=3
else if ((tt[t.x]<>0) and (tt[t.y]=0) and (t.x=t.y-1))
then moveable:=4
else if ((tt[t.x]<>0) and (tt[t.y]=0) and (t.x=t.y-so))
then moveable:=1
else moveable:=0;
end;
function
makemove (tt:state; v:vector; k:integer)[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
var
i:integer;
p[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
begin
new(p);p^.parent := nil;p^.nextsibling := nil; p^.child:=nil;
for i:=1 to max do p^.st := tt;
if k=1 then
begin
p^.st[v.y] :=p^.st[v.x]; p^.st[v.x]:=0;
end;
if k=2 then
begin
p^.st[v.x] :=p^.st[v.y];p^.st[v.y]:=0;
end;
if k=3 then
begin
p^.st[v.x] :=p^.st[v.y];p^.st[v.y]:=0;
end;
if k=4 then
begin
p^.st[v.y] :=p^.st[v.x]; p^.st[v.x]:=0;
end;
makemove:=p;
end;
{--------------------------------------------}
function
succ(n:node)[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
var i:integer;
p,q[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
begin
p:= nil;
for i:= 1 to m do
begin
d:=moveable(movetable,n.st);
if d<>0 then
begin
q:= makemove (n.st,movetable,d);
q^.nextsibling :=p; p:=q;
end;
end;
succ:=p;
end;
{------------------------}
function
he (stdt:state) :integer;{heuristic}
var dem,i:integer;
begin
dem:=0;
for i:=1 to max do
if stdt=state_finish then dem:=dem+1;
he:=9-dem;
end;
{-------------------------------}
function finish (t[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr):boolean;
var b: boolean;
i:integer;
begin
b:=true;
for i:= 1 to MAX do
if t^.st<> state_finish then b:=false;
finish:=b;
end;
{-----------------------------------}
function getmin(b:integer)[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
var
p[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
i,min,dung : integer;
begin
min:=1000; dung:=0;
for i:= 1 to b do
if l^.value< min then
begin
min := l^ .value;
dung:=1;
end;
p:=l[dung];
for i:=dung to b-1 do l:=l[i+1];
getmin:=p;
end;
procedure ta_canh(start[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr);
var n:node;
i:integer;
p,q,dich[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
begin
for i:=1 to CT do new(l);
for i:= 1 to CT do new (qu);
start^.tang:=0;start^.value:=he(start^.st);
start^.parent:=nil;start^.nextsibling:=nil;
start^.child:=nil;
top:= 1;
l [top]:=start;luu:=0;
while ((top>0) and (top<CT)) do
begin
new(p);
p:=getmin(top);
top:=top-1;
{p:=l[top]; top:=top-1;}
luu:=luu+1;
qu[luu]:=p ;
if finish(p)=true then
begin
writeln ('co loi giai ghi o file:ttnt14.dat');
exit;
end
else
begin
for i:= 1 to MAX do
n.st:=p^.st;
new(q); q:=succ(n);
while q<>nil do
begin
q^.tang:=p^.tang+1;
q^.parent:=qu[luu];
qu[luu]^.child:=q;
top:=top+1;l [top]:=q;
q:=q^.nextsibling;
end;
end;
end;
writeln('khong co loi giai');
end;
procedure return_path(w:integer);
var f1:text;
k:integer;
p[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]tr;
begin
for k:= 1 to 20 do new(ketqua[k]);
new(p);
kq:=0;
p:=qu[luu];
repeat
kq:=kq+1;
ketqua[kq]:=p;
p:=p^.parent;
until p=nil;
end;
procedure print_file(var f1:text;m:state);
var k:integer;
begin
for k := 1 to so do
write(f1,m[k],'');
writeln(f1);
for k:=so+1 to 2*so do write(f1,m[k],'');
write(f1);
for k:= 2*so+1 to 3*so do write(f1,m[k],'');
writeln(f1);
writeln(f1);
end;
begin
clrscr;khoitao;ta_canh(start);
return_path(luu);
assign(f,'TTNT14.dat');rewrite(f);
for d:=kq downto 1 do print_file(f,ketqua[d]^.st);
close (f);
readln;
end.
Quyền viết bài
- Bạn Không thể gửi Chủ đề mới
- Bạn Không thể Gửi trả lời
- Bạn Không thể Gửi file đính kèm
- Bạn Không thể Sửa bài viết của mình
-
Nội quy - Quy định
Bạn đang tìm kiếm giải pháp vận chuyển và nâng hạ hàng hoá máy móc nặng cho dự án hay công việc của mình tại khu vực Mỹ Phước - Bình Dương? Chúng tôi tự hào giới thiệu dịch vụ cho thuê xe cẩu tại Mỹ...
Dịch vụ cho thuê xe cẩu tại Mỹ Phước từ 3 tấn 120 tấn