八数码深搜

program bashum;
const
  maxl=100;
  dir:array[1..4,1..2]of integer=((1,0),(-1,0),(0,1),(0,-1));
type
  sta=record
      kx,ky:longint;
      m:array[1..3,1..3]of integer;
      end;

var
  p,ans:array[1..maxl]of sta;
  tar:sta;
  i,j,k,ansl:longint;

function check(k,d:integer):boolean;
var
 i,j:integer;
begin
    if (p[k].kx+dir[d,1]>=1)and(p[k].kx+dir[d,1]<=3)and
         (p[k].ky+dir[d,2]>=1)and(p[k].ky+dir[d,2]<=3) then exit(true) else exit(false);
end;
function can(o:sta):boolean;
var
 i,j:integer;
begin
       can:=true;
       for i:=1 to 3 do
        for j:=1 to 3 do
         if o.m[i,j]<>tar.m[i,j] then exit(false);
end;
function none(m:integer):boolean;
var
 i,j,k:integer;
 flag:boolean;
begin
     none:=true;
     for k:=1 to m-1 do
      begin
          flag:=true;
          for i:=1 to 3 do
           for j:=1 to 3 do
            if p[k].m[i,j]<>p[m].m[i,j] then flag:=false;
          if flag then exit(false);
      end;
end;

procedure play(k:integer);
var
  i,j,d:integer;
begin
       if k>20 then exit;
       if can(p[k])and (k<ansl) then
        begin
             ansl:=k;
             ans:=p;
        end;
       for d:=1 to 4 do
        if check(k,d) then
         begin
              p[k+1]:=p[k];
              p[k+1].m[p[k].kx,p[k].ky]:=p[k+1].m[p[k].kx+dir[d,1],p[k].ky+dir[d,2]];
              p[k+1].m[p[k].kx+dir[d,1],p[k].ky+dir[d,2]]:=0;
              p[k+1].kx:=p[k].kx+dir[d,1];
              p[k+1].ky:=p[k].ky+dir[d,2];
              if none(k+1) then play(k+1);
         end;
end;


begin
       assign(input,'win.in');
       assign(output,'win.out');
       reset(input);
       rewrite(output);
       ansl:=100;
       for i:=1 to 3 do
        begin
             for j:=1 to 3 do
              begin
                  read(p[1].m[i,j]);
                  if p[1].m[i,j]=0 then
                  begin
                      p[1].kx:=i;p[1].ky:=j;
                  end;
              end;
             readln;
        end;
       for i:=1 to 3 do
        begin
             for j:=1 to 3 do
              begin
                  read(tar.m[i,j]);
                  if tar.m[i,j]=0 then
                  begin
                      tar.kx:=i;tar.ky:=j;
                  end;
              end;
             readln;
        end;

       play(1);
       //output
      for k:=1 to ansl do
       begin
        for i:=1 to 3 do
         begin
            for j:=1 to 3 do write(ans[k].m[i,j]);
            writeln;
         end;
         writeln;
      end;
       close(input);
       close(output);
end.

　　找时间在优化吧