1
0

pku2103.dpr 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203
  1. program pku2103;
  2. type Tarr=array[0..20]of longint;
  3. const maxlen=$40000000;
  4. maxn=16;
  5. log=30;
  6. var p,pp,g:array[0..32000]of longint;
  7. cp,sp,w:array[1..maxn,0..32000]of longint;
  8. u:array[2..32000]of boolean;
  9. a:array[1..16]of longint;
  10. ans,ans1,ans2,tmp:Tarr;
  11. n:longint;
  12. procedure makeprimlist;
  13. var i,j:longint;
  14. begin
  15. fillchar(p,sizeof(p),0);
  16. for i:=2 to 32000 do
  17. if not(u[i]) then
  18. begin
  19. inc(p[0]);
  20. p[p[0]]:=i;
  21. for j:=2 to 32000 div i do
  22. u[i*j]:=true;
  23. end;
  24. end;
  25. procedure inputint;
  26. var i,j,tmp:longint;
  27. begin
  28. readln(n);
  29. for i:=1 to n do
  30. begin
  31. read(a[i]);
  32. tmp:=a[i];
  33. for j:=1 to p[0] do
  34. if tmp mod p[j]=0 then
  35. begin
  36. inc(cp[i,0]);
  37. cp[i,cp[i,0]]:=j;
  38. while tmp mod p[j]=0 do
  39. begin
  40. tmp:=tmp div p[j];
  41. inc(sp[i,cp[i,0]]);
  42. end;
  43. pp[j]:=pp[j]+sp[i,cp[i,0]];
  44. if tmp=1 then break;
  45. end;
  46. if tmp>1 then
  47. begin
  48. inc(p[0]);
  49. p[p[0]]:=tmp;
  50. inc(cp[i,0]);
  51. cp[i,cp[i,0]]:=p[0];
  52. sp[i,cp[i,0]]:=1;
  53. pp[p[0]]:=1;
  54. end;
  55. end;
  56. end;
  57. procedure plus(var a,b:Tarr);
  58. var i,t,len:longint;
  59. begin
  60. if a[0]>b[0] then len:=a[0]
  61. else len:=b[0];
  62. t:=0;
  63. for i:=1 to len do
  64. begin
  65. t:=a[i]+b[i]+t;
  66. if t<maxlen then begin a[i]:=t;t:=0 end
  67. else begin a[i]:=t-maxlen;t:=1 end;
  68. end;
  69. if t>0 then
  70. begin
  71. inc(len);
  72. a[len]:=t
  73. end;
  74. a[0]:=len;
  75. end;
  76. procedure minus(var c,a,b:Tarr);
  77. var t,i:longint;
  78. begin
  79. fillchar(c,sizeof(c),0);
  80. t:=0;
  81. for i:=1 to a[0] do
  82. begin
  83. c[i]:=a[i]-b[i]-t;
  84. if c[i]<0 then
  85. begin c[i]:=c[i]+maxlen;t:=1 end
  86. else t:=0;
  87. end;
  88. c[0]:=a[0];
  89. while (c[0]>0)and(c[c[0]]=0) do dec(c[0]);
  90. end;
  91. procedure mul(var a:Tarr;b:int64);
  92. var p:int64;
  93. i:longint;
  94. begin
  95. if b=1 then exit;
  96. p:=0;
  97. for i:=1 to a[0] do
  98. begin
  99. p:=a[i]*b+p shr log;
  100. a[i]:=p and (maxlen-1);
  101. end;
  102. p:=p shr log;
  103. while p>0 do
  104. begin
  105. inc(a[0]);
  106. a[a[0]]:=p and (maxlen-1);
  107. p:=p shr log;
  108. end;
  109. end;
  110. procedure divid(var a:Tarr;b:int64);
  111. var t,tmp:int64;
  112. i:longint;
  113. begin
  114. if b=1 then exit;
  115. t:=0;
  116. for i:=a[0] downto 1 do
  117. begin
  118. tmp:=t*maxlen+a[i];
  119. a[i]:=tmp div b;
  120. t:=tmp mod b;
  121. end;
  122. while (a[0]>0)and(a[a[0]]=0) do dec(a[0]);
  123. end;
  124. function lmod(var a:Tarr;b:int64):int64;
  125. var p:int64;
  126. i:longint;
  127. begin
  128. p:=0;
  129. for i:=a[0] downto 1 do
  130. p:=(p*maxlen+a[i]) mod b;
  131. lmod:=p;
  132. end;
  133. procedure dfs(i,d:longint;tmp:Tarr);
  134. var j,fac:longint;
  135. begin
  136. if i>n then
  137. begin
  138. if d=1 then plus(ans1,tmp)
  139. else plus(ans2,tmp);
  140. exit;
  141. end;
  142. fac:=1;
  143. for j:=1 to cp[i,0] do
  144. begin
  145. w[i,j]:=g[cp[i,j]];
  146. while sp[i,j]>g[cp[i,j]] do
  147. begin
  148. fac:=fac*p[cp[i,j]];
  149. inc(g[cp[i,j]]);
  150. end;
  151. end;
  152. mul(tmp,a[i] div fac);
  153. dfs(i+1,-d,tmp);
  154. for j:=1 to cp[i,0] do
  155. g[cp[i,j]]:=w[i,j];
  156. mul(tmp,fac);
  157. dfs(i+1,d,tmp);
  158. end;
  159. procedure print(var b:Tarr);
  160. var f:boolean;
  161. i:longint;
  162. a:array[1..1000] of longint;
  163. begin
  164. for i:=1 to 1000 do
  165. begin
  166. a[i]:=lmod(b, 10);
  167. divid(b,10);
  168. end;
  169. f:=false;
  170. for i:=1000 downto 2 do
  171. begin
  172. f:=f or (a[i]<>0);
  173. if f then write(a[i]);
  174. end;
  175. writeln(a[1]);
  176. end;
  177. procedure work;
  178. var i,j:longint;
  179. begin
  180. tmp[0]:=1;
  181. tmp[1]:=1;
  182. fillchar(g,sizeof(g),0);
  183. dfs(1,1,tmp);
  184. for i:=1 to n do
  185. mul(tmp,a[i]);
  186. minus(ans,ans1,ans2);
  187. for i:=1 to p[0] do
  188. for j:=1 to pp[i] do
  189. if lmod(ans,p[i])=0 then
  190. begin
  191. divid(ans,p[i]);
  192. divid(tmp,p[i]);
  193. end
  194. else break;
  195. minus(ans1,tmp,ans);
  196. print(ans1);
  197. print(tmp);
  198. end;
  199. begin
  200. makeprimlist;
  201. inputint;
  202. work;
  203. end.