记录编号 8065 评测结果 AWWWTATTAA
题目名称 移动骷髅 最终得分 40
用户昵称 Gravatarzhai 是否通过 未通过
代码语言 Pascal 运行时间 4.235 s
提交时间 2008-11-12 19:45:42 内存使用 99.29 MiB
显示代码纯文本
program klgame;
  const
    max=1000000;
  type
    sx=array[1..5,1..5]of integer;
    sz=array[1..max,-1..24,1..2]of integer;
  var
    f1,f2:text;
    n,ans:longint;
    b:sx;
    a:sz;
    procedure ini;
      var
        i,j:integer;
      begin
        assign(f1,'klgame.in');reset(f1);
        assign(f2,'klgame.out');rewrite(f2);
        readln(f1,n);
      end;
    function pan(t:longint):boolean;
      var
        f,f1:boolean;
        i:longint;
        j:integer;
      begin
        i:=1;
        f:=false;
        while (f=false)and(i<t)do begin
          f1:=true;
          j:=1;
          while (f1) and(j<=a[1,0,1]) do begin
            if(a[i,j,1]<>a[t,j,1])or(a[i,j,2]<>a[t,j,2]) then f1:=false;
            inc(j);
          end;
          f:=f1;
          inc(i);
        end;
        pan:=f;
      end;
    procedure exp(h:longint;var t:longint);
      var
        i,j,k:integer;
        d:integer;
      begin
        for i:=1 to a[h,0,1] do begin
          for j:=1 to a[h,0,1] do
            if i<>j then begin
              if a[h,i,1]=a[h,j,1] then begin
                d:=a[h,i,2]-a[h,j,2];
                inc(t);
                for k:=0 to a[h,0,1]do begin
                    a[t,k,1]:=a[h,k,1];
                    a[t,k,2]:=a[h,k,2];
                  end;
                a[t,-1,1]:=a[h,-1,1]+1;
                if d>1 then a[t,i,2]:=a[h,j,2]+1;
                if d<-1 then a[t,i,2]:=a[h,j,2]-1;
                if pan(t) then dec(t);
              end;
              if a[h,i,2]=a[h,j,2] then begin
                d:=a[h,i,1]-a[h,j,1];
                inc(t);
                for k:=0 to a[h,0,1]do begin
                    a[t,k,1]:=a[h,k,1];
                    a[t,k,2]:=a[h,k,2];
                  end;
                a[t,-1,1]:=a[h,-1,1]+1;
                if d>1 then a[t,i,1]:=a[h,j,1]+1;
                if d<-1 then a[t,i,1]:=a[h,j,1]-1;
                if pan(t) then dec(t);
              end;
            end;
        end;
      end;
    procedure dfs;
      var
        h,t:longint;
        j,k:integer;
      begin
        h:=0;t:=1;
        repeat
          inc(h);
          if (a[h,a[h,0,2],1]=3)and(a[h,a[h,0,2],2]=3) then begin
            ans:=a[h,-1,1];
            exit;
          end else exp(h,t);
        until (t=max)or(h=t);
      end;
    procedure iit;
      var
        j,k,c:integer;
        s:string;
      begin
        fillchar(b,sizeof(b),0);
        c:=1;
        for j:=1 to 5 do begin
          readln(f1,s);
          for k:=1 to 5 do begin
            b[j,k]:=ord(s[k])-48;
            if b[j,k]<>0 then begin
              a[1,c,1]:=j;a[1,c,2]:=k;inc(c);
              if b[j,k]=2 then a[1,0,2]:=c-1;
            end;
          end;
        a[1,-1,1]:=0;
        end;
        readln(f1);
        a[1,0,1]:=c-1;
      end;
    procedure main;
      var
        i:longint;
      begin
        for i:=1 to n do begin
          iit;
          dfs;
          writeln(f2,'level ',i,':');
          writeln(f2,ans);
        end;
      end;
  begin
    ini;
    main;
    close(f1);
    close(f2) ;
  end.