QBCOND - Quan hệ có điều kiện

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      d2:array[0..1] of longint=(2,1);
      d3:array[0..3] of longint=(6,6,0,1);
type int65=longint;
var p:array[0..10] of int65;
    a:array[4..10,0..60] of int65;
    b,com:array[1..10] of int65;
    t:longint; u:int64;

function sum(i:longint):int65;
var j:longint; re:int65;
begin
     re:=0;
     for j:=1 to i do re:=re+b[j];
     sum:=re;
end;

function mul(i:longint):int65;
var j:longint; re:int65;
begin
     re:=1;
     for j:=1 to i do re:=re*p[b[j]];
     mul:=re;
end;


procedure find(pos,num:longint);
var i,s,dem,k:longint;    j:int65;
begin
     i:=0;
     while i<num do
     begin
          inc(i);
          b[pos]:=i;
          s:=sum(pos);
          if s=num then
          begin
               dem:=0;
               for k:=1 to pos do dem:=dem+com[b[k]];
               a[num,dem]:=a[num,dem]+p[num] div mul(pos);
          end
          else
          begin
               if (s<num) then find(pos+1,num)
               else
               begin
                    b[pos]:=0;
                    break;
               end;
          end;
          b[pos]:=0;
     end;
end;

procedure init;
var i,j:longint; t:int65;
begin
     p[0]:=1; p[1]:=1;
     t:=1; j:=1; com[1]:=0;
     while t<10 do
     begin
          inc(t);
          inc(j);
          p[t]:=p[t-1]*t;
          com[t]:=com[t-1]+t-1;
     end;
     fillchar(a,sizeof(a),0);
     for i:=4 to 10 do
         find(1,i);
end;

begin
     init;
     assign(input,fi);
     reset(input);
     assign(output,fo);
     rewrite(output);
     read(t);
     while t<>-1 do
     begin
          readln(u);
          if t=2 then
begin
if u>1 then writeln(0) else writeln(d2[u]);
end
          else
begin
if t=3 then 
begin
if u>3 then writeln(0) else writeln(d3[u]);
end
else
begin
          if u<60 then writeln(a[t,u])
          else writeln(0);
end;
end;
          read(t);
     end;
     close(input);
     close(output);
end.

Download