HNOI2008明明的烦恼

写的很好的题解：http://www.cnblogs.com/zhj5chengfeng/archive/2013/08/23/3278557.html

我这种蒻蒻什么都不会啊……

代码：（copy的）

  var
   a:array[..]of longint;
   su,p:array[..]of longint;
   b:array[..]of boolean;
   ans:array[..]of longint;
   i,j,m,n,s,k,w,sum,c:longint;
 procedure add(t,d:longint);
 var
   i:longint;
 begin
   for i:= to s do
     while t mod su[i]= do
       begin
         inc(p[i],d);
         t:=t div su[i];
       end;
 end;
 procedure cheng(t:longint);
 var
   i:longint;
 begin
   for i:= to c do
     ans[i]:=ans[i]*t;
   for i:= to c- do
     begin
       inc(ans[i+],ans[i] div );
       ans[i]:=ans[i] mod ;
     end;
   while ans[c]>= do
     begin
       ans[c+]:=ans[c] div ;
       ans[c]:=ans[c] mod ;
       inc(c);
     end;
 end;
 begin
   readln(n);
   for i:= to n do
     read(a[i]);
   fillchar(b,sizeof(b),true);
   for i:= to n do
     if b[i] then
       begin
         inc(s);
         su[s]:=i;
         for j:= to n div i do
           b[i*j]:=false;
       end;
   fillchar(p,sizeof(p),);
   sum:=n-;
   k:=n;
   for i:= to n do
     if a[i]<>- then
       begin
         for j:= to a[i]- do
           begin
             add(sum,);
             dec(sum);
             add(j,-);
           end;
         dec(k);
       end;
   c:=;
   fillchar(ans,sizeof(ans),);
   ans[]:=;
   for i:= to s do
     for j:= to p[i] do
       cheng(su[i]);
   for i:= to sum do
     cheng(k);
   for i:=c downto  do
     write(ans[i]);
 end.

尼玛，总是出现莫名的bug ，浪费我的时间！

 var i,j,sum,tot,n:longint;
     a,b,p,d:array[..] of longint;
     flag:boolean;
 procedure init;
  begin
  readln(n);sum:=;tot:=;
  for i:= to n do
   begin
    readln(d[i]);
    if (d[i]=) or (d[i]>n-) then flag:=true;
    if d[i]<>- then begin inc(tot);inc(sum,d[i]-);end;
   end;
  end;
 procedure incc(x:longint);
  var i:longint;
  begin
  for i:= to x do
   begin
   if x mod i= then
    while x mod i= do
     begin
     inc(p[i]);
     x:=x div i;
     if x= then break;
     end;
   end;
  end;
 procedure decc(x:longint);
  var i:longint;
  begin
  for i:= to x do
   begin
   if x mod i= then
    while x mod i= do
     begin
     dec(p[i]);
     x:=x div i;
     if x= then break;
     end;
   end;
  end;
 procedure mul(x:longint);
  var i:longint;
  begin
  for i:= to b[]+ do
   begin
   b[i]:=b[i]*x;
   inc(b[i+],b[i] div );
   b[i]:=b[i] mod ;
   end;
  while b[b[]+]<> do inc(b[]);
  end;
 procedure main;
  begin
  fillchar(p,sizeof(p),);
  for i:=n--sum+ to n- do incc(i);
  for i:= to n--sum do incc(n-tot);
  for i:= to n do
   if d[i]<>- then
    begin
    for j:= to d[i]- do decc(j);
    end;
  b[]:=;b[]:=;
  for i:= to n do if p[i]<> then for j:= to p[i] do mul(i);
  end;
 procedure print;
  begin
  write(b[b[]]);
  for i:=b[]- downto  do
   begin
   if b[i]>= then write(b[i]) else
   if b[i]>= then write('',b[i]) else
   if b[i]>= then write('',b[i]) else
   write('',b[i]);
   end;
  end;
 begin
  assign(input,'input.txt');assign(output,'output.txt');
  reset(input);rewrite(output);
  flag:=false;
  init;
  if flag then writeln() else begin main;print;end;
  close(input);close(output);
 end.