ac1144.pas

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

program tju1144;
var
  count:array[0..5,0..5,0..5,0..5,0..5]of longint;
  map:array[1..5,1..5]of char;
  len:array[0..5]of byte;
  n,t:longint;
  i,j:byte;
  c:char;
  s:string[25];
procedure calcount;
  var
    a,b,c,d,e:byte;
  begin
    fillchar(count,sizeof(count),0);
    count[5,5,5,5,5]:=1;
    for a:=5 downto 0 do
      for b:=a downto 0 do
        for c:=b downto 0 do
          for d:=c downto 0 do
            for e:=d downto 0 do begin
              if a<5 then inc(count[a,b,c,d,e],count[a+1,b,c,d,e]);
              if b<a then inc(count[a,b,c,d,e],count[a,b+1,c,d,e]);
              if c<b then inc(count[a,b,c,d,e],count[a,b,c+1,d,e]);
              if d<c then inc(count[a,b,c,d,e],count[a,b,c,d+1,e]);
              if e<d then inc(count[a,b,c,d,e],count[a,b,c,d,e+1]);
            end;
  end;
procedure solve_n;
  begin
    readln(n);
    for c:='A' to 'Y' do begin
      for i:=1 to 5 do
        if len[i]<len[i-1] then begin
          inc(len[i]);
          t:=count[len[1],len[2],len[3],len[4],len[5]];
          if t<n then dec(n,t) else break;
          dec(len[i]);
        end;
      map[i,len[i]]:=c;
    end;

    for i:=1 to 5 do
      for j:=1 to 5 do
        write(map[i,j]);
    writeln;
  end;
procedure solve_w;
  begin
    readln(s);
    n:=1;
    for c:='A' to 'Y' do begin
      j:=(pos(c,s)+4) div 5;
      for i:=1 to j-1 do
        if len[i]<len[i-1] then begin
          inc(len[i]);
          inc(n,count[len[1],len[2],len[3],len[4],len[5]]);
          dec(len[i]);
        end;
      inc(len[j]);
    end;
    writeln(n);
  end;
begin
  calcount;
  repeat
    fillchar(len,sizeof(len),0);len[0]:=5;
    readln(c);
    case c of
      'N':solve_n;
      'W':solve_w;
    end;
  until seekeof;
end.