ac1143.pas

某牛人写的acm.tongji.edu.cn上大部分ac的代码,仅供学习研究,请不要用来作弊

program tju1143;
const
  states=6*6*6*6*6;
var
  x,y:array['A'..'Y']of byte;
  len:array[0..5]of byte;
  f:array[0..states-1]of longint;
  s:array[1..25]of char;
  c:char;
function cal(c:char):longint;
  var
    state,i:longint;
  begin
    state:=0;for i:=1 to 5 do state:=state*6+len[i];
    if f[state]<0 then begin
      f[state]:=0;
      if x[c]=0 then begin
        for i:=1 to 5 do
          if len[i]<len[i-1] then begin
            inc(len[i]);
            inc(f[state],cal(succ(c)));
            dec(len[i]);
          end
      end
      else
        if (len[x[c]]<len[x[c]-1]) and (len[x[c]]+1=y[c]) then begin
          inc(len[x[c]]);
          inc(f[state],cal(succ(c)));
          dec(len[x[c]]);
        end;
    end;
    cal:=f[state];
  end;
function count:longint;
  begin
    fillchar(len,sizeof(len),0);len[0]:=5;
    fillchar(f,sizeof(f),255);f[states-1]:=1;
    count:=cal('A');
  end;
procedure solve_n;
  var
    n,t,i,j:longint;
  begin
    readln(n);
    for i:=1 to 5 do
      for j:=1 to 5 do
        for c:='A' to 'Y' do
          if x[c]=0 then begin
            x[c]:=i;y[c]:=j;
            t:=count;
            if n>t then dec(n,t) else break;
            x[c]:=0;
          end;
    for c:='A' to 'Y' do
      s[(x[c]-1)*5+y[c]]:=c;
    for i:=1 to 25 do
      write(s[i]);
    writeln;
  end;
procedure solve_w;
  var
    n,i,j:longint;
    k:char;
  begin
    n:=1;
    for i:=1 to 5 do
      for j:=1 to 5 do begin
        read(c);
        for k:='A' to pred(c) do
          if x[k]=0 then begin
            x[k]:=i;y[k]:=j;
            inc(n,count);
            x[k]:=0;
          end;
        x[c]:=i;y[c]:=j;
      end;
    readln;
    writeln(n);
  end;
begin
  repeat
    fillchar(x,sizeof(x),0);
    fillchar(y,sizeof(y),0);
    readln(c);
    case c of
      'N':solve_n;
      'W':solve_w;
    end;
  until seekeof;
end.