SHTH - Số hiệu tổ hợp
Tác giả: flashmt
Ngôn ngữ: Pascal
const maxn=310;
base=100000000;
type bignum=array[0..14] of longint;
var n,k:longint;
c:array[0..maxn,0..maxn] of bignum;
a,re:array[0..maxn] of longint;
s,res:bignum;
procedure rf;
var i,j,l:longint; s1,t:string; code:integer;
begin
readln(n,k);
readln(s1);
l:=length(s1);
s[0]:=(l+7) div 8;
for i:=1 to s[0]-1 do
begin
t:=copy(s1,l-i*8+1,8);
val(t,j,code);
s[i]:=j;
end;
l:=l mod 8;
if l=0 then l:=8;
t:=copy(s1,1,l);
val(t,j,code);
s[s[0]]:=j;
for i:=1 to k do read(a[i]);
end;
procedure plus(var c:bignum;a,b:bignum);
var max,i,mem:longint;
begin
if a[0]>=b[0] then max:=a[0] else max:=b[0];
mem:=0;
for i:=1 to max do
begin
c[i]:=(a[i]+b[i]+mem) mod base;
mem:=(a[i]+b[i]+mem) div base;
end;
if mem>0 then
begin
inc(max);
c[max]:=mem;
end;
c[0]:=max;
end;
function small(a,b:bignum):boolean;
var i:longint;
begin
small:=true;
if a[0]<b[0] then exit;
if a[0]>b[0] then
begin
small:=false;
exit;
end;
for i:=a[0] downto 1 do
if b[i]<a[i] then
begin
small:=false;
exit;
end
else
begin
if b[i]>a[i] then exit;
end;
end;
procedure minus(var a:bignum;b:bignum);
var i,max,mem:longint;
begin
if a[0]>=b[0] then max:=a[0] else max:=b[0];
mem:=0;
for i:=1 to max do
begin
if a[i]>=b[i]+mem then
begin
a[i]:=a[i]-b[i]-mem;
mem:=0;
end
else
begin
a[i]:=base+a[i]-b[i]-mem;
mem:=1;
end;
end;
while (a[max]=0) and (max>0) do dec(max);
a[0]:=max;
end;
procedure init;
var i,j,t:longint;
begin
fillchar(re,sizeof(re),0);
fillchar(c,sizeof(c),0);
for i:=1 to n do
begin
c[i,0,1]:=1;
c[i,i,1]:=1;
c[i,0,0]:=1;
c[i,i,0]:=1;
end;
for i:=2 to n do
begin
if i-1<=k then t:=i-1 else t:=k;
for j:=1 to t do
plus(c[i,j],c[i-1,j],c[i-1,j-1]);
end;
end;
procedure timth;
var i,j:longint; t:bignum;
begin
for i:=1 to k do
begin
for j:=re[i-1]+1 to n+i-k do
begin
t:=c[n-j,k-i];
if small(s,t) then
begin
re[i]:=j;
break;
end
else minus(s,t);
end;
end;
if re[k]=0 then re[k]:=n;
end;
procedure doith;
var i,j,t:longint;
begin
res[0]:=1; res[1]:=1;
for i:=1 to k do
for j:=a[i-1]+2 to a[i] do
plus(res,res,c[n-j+1,k-i]);
end;
procedure wf;
var i,l,j:longint; s:string;
begin
for i:=1 to k do write(re[i],' ');
writeln;
for i:=res[0] downto 1 do
begin
if i<res[0] then
begin
str(res[i],s);
l:=length(s);
for j:=l+1 to 8 do write(0);
end;
write(res[i]);
end;
end;
begin
rf;
init;
timth;
doith;
wf;
end.