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.

Download