ac1280.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

{$Q-,R-}
program tju1280;
const
  move:array[1..2,0..8]of byte=((3,0,1,6,4,2,7,8,5),(0,1,2,5,3,4,6,7,8));
  fact:array[1..9]of longint=(1,2,6,24,120,720,5040,40320,362880);
  fact9=362880;
type
  board=array[0..8]of byte;
var
  q:array[0..fact9]of board;
  side:array[0..fact9-1]of byte;
  f1,r1,f2,r2,p,i,m,t,ans:longint;
  succeed:boolean;
function id(a:board):longint;
  var
    i,j:longint;
  begin
    id:=0;
    for i:=8 downto 1 do begin
      inc(id,a[i]*fact[i]);
      for j:=1 to i-1 do
        if a[j]>a[i] then dec(a[j]);
    end;
  end;
begin
  repeat
    fillchar(side,sizeof(side),0);
    f1:=0;r1:=0;f2:=fact9;r2:=fact9;
    for i:=0 to 8 do read(q[r1,i]);side[id(q[r1])]:=1;
    for i:=0 to 8 do read(q[r2,i]);side[id(q[r2])]:=2;
    ans:=0;succeed:=false;
    repeat
      inc(ans);
      for p:=f1 to r1 do
        for m:=1 to 2 do begin
          inc(r1);
          for i:=0 to 8 do q[r1,i]:=q[p,move[m,i]];
          t:=id(q[r1]);
          case side[t] of
            0:side[t]:=1;
            1:dec(r1);
            2:begin succeed:=true;break;end;
          end;
        end;
      if succeed then break;
      f1:=p+1;

      inc(ans);
      for p:=f2 downto r2 do
        for m:=1 to 2 do begin
          dec(r2);
          for i:=0 to 8 do q[r2,move[m,i]]:=q[p,i];
          t:=id(q[r2]);
          case side[t] of
            0:side[t]:=2;
            1:begin succeed:=true;break;end;
            2:inc(r2);
          end;
        end;
      if succeed then break;
      f2:=p-1;
    until false;
    writeln(ans);
  until seekeof;
end.