最新公告
  • 欢迎光临可关玩日记,免费分享生活知识及创业资讯
  • 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 t<>1 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<4)and(yy<4)then begin p:=map; p[bx,by]:=p[xx,yy];p[xx,yy]:=0; inc(open);if open=3001 then break; notes[open].father:=close; notes[open].step:=step+1; notes[open].map:=p; notes[open].bx:=xx;notes[open].by:=yy; getpoint(open); if same(p,finish)then begin print(open); halt; end; for j:=1 to open-1 do if same(p,notes[j].map)then begin dec(open);break; end; end; end; end; procedure chose; var swap:rec; i,j:integer; begin j:=close; for i:=close+1 to open do if notes[i].pointopen); writeln(‘No resule’); end. 这个是用启发式做的哈!~~[j].point>