SHTH - Số hiệu tổ hợp

Tác giả: RR

Ngôn ngữ: Pascal

{$R+,Q+}
uses math;
const
  FINP='';
  FOUT='';
  MAXN=101;
  MAXM=301;
  oo=100000000;
type
  bigNum=array[0..MAXN] of longint;
var
  f1,f2:text;
procedure print(a:bigNum);
var
  i:longint;
  s:string;
begin
  if a[0]=0 then begin writeln(f2,0); exit; end;
  write(f2,a[MAXN-a[0]+1]);
  for i:=MAXN-a[0]+2 to MAXN do
    begin
      str(a[i],s);
      while length(s)<8 do s:='0'+s;
      write(f2,s);
    end;
  writeln(f2);
end;
operator <(a,b:bigNum) c:boolean;
var
  i:longint;
begin
  if a[0]<b[0] then exit(true)
  else if a[0]>b[0] then exit(false);
  for i:=MAXN-a[0]+1 to MAXN do
    if a[i]<b[i] then exit(true)
    else if a[i]>b[i] then exit(false);
  exit(false);
end;
operator +(a,b:bigNum) c:bigNum;
var
  nho,i:longint;
begin
  nho:=0;
  fillchar(c,sizeof(c),0); c[0]:=max(a[0],b[0]);
  for i:=MAXN downto MAXN-c[0]+1 do
    begin
      c[i]:=a[i]+b[i]+nho;
      nho:=c[i] div oo;
      c[i]:=c[i] mod oo;
    end;
  if nho>0 then
    begin
      inc(c[0]);
      c[MAXN-c[0]+1]:=nho;
    end;
end;
operator -(var a,b:bigNum) c:bigNum;
var
  nho,i:longint;
begin
  nho:=0;
  fillchar(c,sizeof(c),0); c[0]:=a[0];
  for i:=MAXN downto MAXN-c[0]+1 do
    begin
      c[i]:=a[i]-b[i]-nho;
      if c[i]<0 then
        begin
          nho:=1;
          c[i]:=c[i]+oo;
        end
      else nho:=0;
    end;
  while (c[0]>0) and (c[MAXN-c[0]+1]=0) do dec(c[0]);
end;
procedure trans(s:ansistring;var a:bigNum);
var
  ss:ansistring;
  code:integer;
begin
  fillchar(a,sizeof(a),0);
  while length(s)>7 do
    begin
      ss:=copy(s,length(s)-7,8);
      delete(s,length(s)-7,8);
      val(ss,a[MAXN-a[0]],code);
      inc(a[0]);
    end;
  if length(s)>0 then
    begin
      val(s,a[MAXN-a[0]],code);
      inc(a[0]);
    end;
end;
var
  xet,a:array[0..MAXM] of longint;
  c:array[0..MAXM,0..MAXM] of bigNum;
  tt:bigNum;
  n,k:longint;
procedure openF;
begin
  assign(f1,FINP); reset(f1);
  assign(f2,FOUT); rewrite(f2);
end;
procedure closeF;
begin
  close(f1); close(f2);
end;
procedure inp;
var
  i,j:longint;
begin
  readln(f1,n,k);
  c[0,0][0]:=1; c[0,0][MAXN]:=1;
  for i:=1 to MAXM do
    begin
      c[i,0][0]:=1; c[i,0][MAXN]:=1;
      c[i,i][0]:=1; c[i,i][MAXN]:=1;
    end;
  for i:=1 to MAXM do
  for j:=1 to i-1 do
    c[i,j]:=c[i-1,j-1]+c[i-1,j];
end;
procedure solve1;
var
  s:ansistring;
  u,i:longint;
begin
  readln(f1,s);
  trans(s,tt);
  for i:=1 to k do
    begin
      u:=a[i-1]+1; while xet[u]=1 do inc(u);
      while (c[n-u,k-i]<tt) do
        begin
          tt:=tt-c[n-u,k-i];
          inc(u); while xet[u]=1 do inc(u);
        end;
      xet[u]:=1; a[i]:=u;
    end;
  for i:=1 to k do
    write(f2,a[i],' ');
  writeln(f2);
end;
procedure solve2;
var
  i,u,count:longint;
begin
  fillchar(xet,sizeof(xet),0);
  fillchar(tt,sizeof(tt),0);
  for i:=1 to k do read(f1,a[i]);
  xet[0]:=1;
  for i:=1 to k do
    begin
      u:=a[i-1]; while xet[u]=1 do inc(u); count:=0;
      while (u<a[i]) do
        begin
          if xet[u]=0 then tt:=tt+c[n-u,k-i];
          inc(u);
        end;
      xet[a[i]]:=1;
    end;
  print(tt+c[0,0]);
end;
begin
  openF;
  inp;
  solve1;
  solve2;
  closeF;
end.

Download