Mathematica取幂并找到指定的系数

时间:2011-06-26 17:48:05

标签: optimization wolfram-mathematica discrete-mathematics

我有以下代码,它完全符合我的要求,但它的速度非常慢。我不会那么烦恼,除了当我“手动”处理代码时,即我把它分成几部分并单独进行,它几乎是瞬间的。

这是我的代码:

Coefficient[Product[Sum[x^(j*Prime[i]), {j, 0, Floor[q/Prime[i]]}], 
                        {i, 1, PrimePi[q]}], x, q]

为了清晰起见添加了图片:

enter image description here

我认为它正在努力优化总和,但我不确定。有没有办法阻止它?

另外,由于我的所有系数都是正数,而我只想要x ^ qth系数,有没有办法让Mathematica丢弃所有大于那个的指数而不是用它们进行所有乘法?

2 个答案:

答案 0 :(得分:5)

我可能误解了你想要的东西,但由于系数将取决于q,我假设你希望它针对特定的q进行评估。因为我怀疑(像你一样)时间用于优化产品和总和,我重写了它。你有类似的东西:

With[{q = 80}, Coefficient[\!\(
\*UnderoverscriptBox[\(\[Product]\), \(i = 1\), \(PrimePi[q]\)]\((
\*UnderoverscriptBox[\(\[Sum]\), \(j = 0\), \(\[LeftFloor]
\*FractionBox[\(q\), \(Prime[i]\)]\[RightFloor]\)]
\*SuperscriptBox[\(x\), \(j*Prime[i]\)])\)\), x, q]] // Timing
(*
-> {8.36181, 10003}
*)

我用纯粹的结构操作重写了

With[{q = 80},
 Coefficient[Times @@ 
 Table[Plus @@ Table[x^(j*Prime[i]), {j, 0, Floor[q/Prime[i]]}],
        {i, 1, PrimePi[q]}], x, q]] // Timing
(*
-> {8.36357, 10003}
*)

(这只会建立一个术语列表然后将它们相乘,因此不会执行符号分析。)

只是建立多项式是瞬时的,但它有几千个项,所以可能发生的是Coefficient花费大量时间来确保它具有正确的系数。实际上你可以通过Expand多项式来解决这个问题。因此:

 With[{q = 80}, Coefficient[Expand[\!\(
 \*UnderoverscriptBox[\(\[Product]\), \(i = 1\), \(PrimePi[q]\)]\((
 \*UnderoverscriptBox[\(\[Sum]\), \(j = 0\), \(\[LeftFloor]
 \*FractionBox[\(q\), \(Prime[i]\)]\[RightFloor]\)]
 \*SuperscriptBox[\(x\), \(j*Prime[i]\)])\)\)], x, q]] // Timing
 (*
 -> {0.240862, 10003}
 *)

它也适用于我的方法。

总而言之,只需将Expand粘贴在表达式前面,然后再取系数。

答案 1 :(得分:1)

我认为原始代码速度慢的原因是因为Coefficient即使使用非常大的表达式也可以工作 - 如果天真地扩展则不适合内存。

这是原始的多项式:

poly[q_, x_] := Product[Sum[ x^(j*Prime[i]), 
                            {j, 0, Floor[q/Prime[i]]}], {i, 1, PrimePi[q]}]

了解如何不太大q,扩展多项式会占用更多内存并变得相当慢:

In[2]:= Through[{LeafCount, ByteCount}[poly[300, x]]] // Timing
        Through[{LeafCount, ByteCount}[Expand@poly[300, x]]] // Timing
Out[2]= { 0.01, { 1859,   55864}}
Out[3]= {25.27, {77368, 3175840}}

现在让我们以3种不同的方式定义系数并计算时间

coeff[q_]    := Module[{x}, Coefficient[poly[q, x], x, q]]
exCoeff[q_]  := Module[{x}, Coefficient[Expand@poly[q, x], x, q]]
serCoeff[q_] := Module[{x}, SeriesCoefficient[poly[q, x], {x, 0, q}]]

In[7]:= Table[   coeff[q],{q,1,30}]//Timing
        Table[ exCoeff[q],{q,1,30}]//Timing
        Table[serCoeff[q],{q,1,30}]//Timing
Out[7]= {0.37,{0,1,1,1,2,2,3,3,4,5,6,7,9,10,12,14,17,19,23,26,30,35,40,46,52,60,67,77,87,98}}
Out[8]= {0.12,{0,1,1,1,2,2,3,3,4,5,6,7,9,10,12,14,17,19,23,26,30,35,40,46,52,60,67,77,87,98}}
Out[9]= {0.06,{0,1,1,1,2,2,3,3,4,5,6,7,9,10,12,14,17,19,23,26,30,35,40,46,52,60,67,77,87,98}}

In[10]:=    coeff[100]//Timing
          exCoeff[100]//Timing
         serCoeff[100]//Timing
Out[10]= {56.28,40899}
Out[11]= { 0.84,40899}
Out[12]= { 0.06,40899}

所以SeriesCoefficient绝对是你要走的路。当然,除非你是 组合数比我好一点,你知道以下主要分区公式 (oeis

In[13]:= CoefficientList[Series[1/Product[1-x^Prime[i],{i,1,30}],{x,0,30}],x]
Out[13]= {1,0,1,1,1,2,2,3,3,4,5,6,7,9,10,12,14,17,19,23,26,30,35,40,46,52,60,67,77,87,98}

In[14]:= f[n_]:=Length@IntegerPartitions[n,All,Prime@Range@PrimePi@n]; Array[f,30]
Out[14]= {0,1,1,1,2,2,3,3,4,5,6,7,9,10,12,14,17,19,23,26,30,35,40,46,52,60,67,77,87,98}