八数码问题 求大牛看看
pascal吧
全部回复
仅看楼主
level 1
班靖琪0Gb 楼主
const
u:array[1..4]of longint=(-1,0,0,1);
w:array[1..4]of longint=(0,-1,1,0);var f:boolean;
i,j,h,t,x1,y1:longint; a:array[1..3,1..3]of integer; b:array[0..8,0..8,0..8,0..8,0..8,0..8,0..8,1..2]of boolean; c:array[1..3,1..3]of longint; d:array[1..9]of longint;
q:array[0..10000000]of record
x,y,step:longint;
k:array[1..3,1..3]of integer;
end; //-----------------
procedure take_notes;
var s:string; i,j:longint;
begin
s:='012345678';
for i:=1 to 2 do
for j:=1 to 3 do
delete(s,pos(chr(q[t].k[i,j]+48),s),1);
delete(s,pos(chr(q[t].k[3,1]+48),s),1);
if q[t].k[3,2]=(ord(s[1])-ord('0')) then b[q[t].k[1,1],q[t].k[1,2],q[t].k[1,3],q[t].k[2,1],q[t].k[2,2],q[t].k[2,3],q[t].k[3,1],1]:=false
else b[q[t].k[1,1],q[t].k[1,2],q[t].k[1,3],q[t].k[2,1],q[t].k[2,2],q[t].k[2,3],q[t].k[3,1],2]:=false; end;
//---------------------
function check:boolean;
var s:string; i,j:longint;
begin
check:=true;
s:='012345678';
for i:=1 to 2 do
for j:=1 to 3 do
delete(s,pos(chr(q[t].k[i,j]+48),s),1);
delete(s,pos(chr(q[t].k[3,1]+48),s),1);
if b[q[h].k[1,1],q[h].k[1,2],q[h].k[1,3],q[h].k[2,1],q[h].k[2,2],q[h].k[2,3],q[h].k[3,1],1]=false and (q[h].k[3,2]=ord(s[1])-ord('0')) then check:=false;
if b[q[h].k[1,1],q[h].k[1,2],q[h].k[1,3],q[h].k[2,1],q[h].k[2,2],q[h].k[2,3],q[h].k[3,1],2]=false and (q[h].k[3,2]=ord(s[2])-ord('0')) then check:=false;
end;
//--------------
procedure search;
var n,m,p,step:longint;
begin
h:=0; t:=1; q[1].x:=x1; q[1].y:=y1; q[1].k:=a; take_notes;
while h<t do
begin
inc(h);
for i:=1 to 4 do begin
n:=q[h].x+u[i]; m:=q[h].y+w[i]; step:=q[h].step;
if(n>0)and(n<4)and(m>0)and(m<4) then begin
p:=q[h].k[q[h].x,q[h].y]; q[h].k[q[h].x,q[h].y]:=q[h].k[n,m]; q[h].k[n,m]:=p;
if check then begin
if (q[h].k[1,1]=c[1,1])and(q[h].k[1,2]=c[1,2]) and(q[h].k[1,3]=c[1,3])and(q[h].k[2,1]=c[2,1]) and(q[h].k[2,2]=c[2,2])and(q[h].k[2,3]=c[2,3]) and(q[h].k[3,1]=c[3,1])and(q[h].k[3,2]=c[3,2])
then
begin
inc(step);writeln(step);f:=true;exit;
end;
inc(t); q[t].x:=n; q[t].y:=m; q[t].step:=q[h].step+1; q[t].k:=q[h].k; take_notes; end;
p:=q[h].k[q[h].x,q[h].y]; q[h].k[q[h].x,q[h].y]:=q[h].k[n,m];
q[h].k[n,m]:=p;
end;
end;
end;
end; //-------------
begin
fillchar(b,sizeof(b),true);
for i:=1 to 3 do
for j:=1 to 3 do begin
read(a[j,i]);
if a[j,i]=0 then begin
x1:=j; y1:=i;
end;
end;
for i:=1 to 3 do
for j:=1 to 3 do
read(c[j,i]);
search;
if not f then writeln('No Solution!');
end.
2015年08月23日 07点08分 1
level 1
班靖琪0Gb 楼主
请看看有什么问题吗 测试的时候只能过6个点
2015年08月23日 07点08分 2
level 14
八数码poj,hdu上都有。。一般是要A*的,反正我宽搜水掉。给你poj代码,可能与你的题意读入稍不同。
type
Miku=array[0..9]of longint;
const
p=362880;
b:Miku=(1,1,2,6,25,120,720,5040,40320,p);
d:array[1..4]of longint=(-3,-1,1,3);
s:array[1..4]of char=('u','l','r','d');
var
i,j,t,l,r:longint;
c:char;
a:Miku;
g:array[-5..15]of boolean;
q:array[0..p]of Miku;
h:array[0..p]of boolean;
f,o:array[0..p]of longint;
procedure qwq(var a,b:longint);
var c:longint; begin c:=a; a:=b; b:=c end;
function Cantor(var a:Miku):longint;
var
i,j,k:longint;
begin
Cantor:=0;
for i:=1 to 9 do
begin
k:=a[i];
for j:=1 to i-1 do if a[j]<a[i] then dec(k);
inc(Cantor,k*b[9-i])
end
end;
procedure Pr(x:longint);
begin
if f[x]=0 then exit;
Pr(f[x]);
write(s[o[x]])
end;
begin
// assign(input,'1077.in'); reset(input);
// assign(output,'1077.out'); rewrite(output);
b[0]:=1;
for i:=1 to 9 do
begin
g[i]:=true;
c:=' ';
while c=' ' do read(c);
a[i]:=ord(c)-48;
if (a[i]<1)or(a[i]>9) then
begin
a[i]:=0;
a[0]:=i
end
end;
t:=Cantor(a);
if t=0 then halt;
h[t]:=true;
q[1]:=a;
l:=0;
r:=1;
repeat
inc(l);
a:=q[l];
for i:=1 to 4 do
if g[a[0]+d[i]] then
begin
if (i=2)and(a[0]mod 3=1) then continue;
if (i=3)and(a[0]mod 3=0) then continue;
inc(r);
f[r]:=l;
o[r]:=i;
q[r]:=a;
q[r,0]:=a[0]+d[i];
qwq(q[r,a[0]+d[i]],q[r,a[0]]);
t:=Cantor(q[r]);
if t=46234 then begin Pr(r); halt end;
if h[t] then dec(r)
else h[t]:=true
end
until l=r;
write('unsolvable');
// close(input); close(output)
end.
2015年08月24日 19点08分 4
level 14
后来又写了个A*优化(IDA*)
var i,j,D,Cnt,Lim:longint; c:char; a:array[1..9]of longint; Ans:array[0..105]of char;function step(x,y:longint):longint;begin dec(x); dec(y); exit(abs(x div 3-y div 3)+abs(x mod 3-y mod 3))end;function h:longint;var i:longint;begin h:=0; for i:=1 to 9 do if a[i]>0 then inc(h,step(i,a[i]))end;function CK:boolean;var i:longint;begin for i:=1 to 8 do if a[i]<>i then exit(false); exit(true)end;procedure PR;var i:longint;begin for i:=1 to Lim do write(Ans[i]); haltend;function sk(k,x:longint):boolean;begin if k>Lim then if CK then PR else exit(false); if k-1+h>Lim then exit(false); if (x>3)and(Ans[k-1]<>'d') then begin a[x]:=a[x-3]; a[x-3]:=0; Ans[k]:='u'; if sk(k+1,x-3) then exit(true); a[x-3]:=a[x]; a[x]:=0 end; if (x mod 3<>0)and(Ans[k-1]<>'l') then begin a[x]:=a[x+1]; a[x+1]:=0; Ans[k]:='r'; if sk(k+1,x+1) then exit(true); a[x+1]:=a[x]; a[x]:=0 end; if (x<7)and(Ans[k-1]<>'u') then begin a[x]:=a[x
+3
]; a[x+3]:=0; Ans[k]:='d'; if sk(k+1,x+3) then exit(true); a[x+3]:=a[x]; a[x]:=0 end; if (x mod 3<>1)and(Ans[k-1]<>'r') then begin a[x]:=a[x-1]; a[x-1]:=0; Ans[k]:='l'; if sk(k+1,x-1) then exit(true); a[x-1]:=a[x]; a[x]:=0 end; exit(false)end;begin for i:=1 to 9 do begin c:=' '; while c=' ' do read(c); if c='x' then begin a[i]:=0; D:=i end else a[i]:=ord(c)-48 end; for i:=2 to 9 do if i<>D then for j:=1 to i-1 do inc(Cnt,ord(a[j]>a[i])); if odd(Cnt) then begin write('unsovable'); halt end; Lim:=h; while not sk(1,D) do inc(Lim)end.
这时间差距我想也不用多说了
2015年08月25日 11点08分 5
1