Exponentiation mathématique et trouver un coefficient spécifié

Question

J'ai le code suivant, et il fait exactement ce que je veux qu'il fasse, sauf qu'il est ridiculement lent. Je ne serais pas si dérangé, sauf que lorsque je traite le code "manuellement", c'est-à-dire que je le divise en parties et que je le fais individuellement, c'est presque instantané.

Voici mon code:

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

Image ajouté pour plus de clarté:

Je pense qu'il essaie d'optimiser la somme, mais ne suis pas sûr. Y a-t-il un moyen d'arrêter cela? De plus, puisque tous mes coefficients sont positifs, et je veux seulement le x^qth, est-il possible d'obtenir que Mathematica rejette tous les exposants qui sont plus grands que cela et ne fasse pas toute la multiplication avec ceux-ci?

Answer 1

Je peux mal comprendre ce que vous voulez, mais, comme le coefficient dépendra de q, je suppose que vous voulez qu'il soit évalué pour q spécifique. Depuis que j'ai suspecté (comme vous) que le temps est pris pour optimiser le produit et la somme, je l'ai réécrit. Vous avez eu quelque chose comme:

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} 
*) 

que je réécris des opérations structurelles purement comme

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} 
*) 

(cela construit juste une liste des termes et les multiplie, donc aucune analyse symbolique est effectuée).

Juste construire le polynôme est instantané, mais il a quelques milliers de termes, donc ce qui se passe probablement est que Coefficient passe beaucoup de temps à s'assurer qu'il a le bon coefficient. En fait, vous pouvez résoudre cela par Expand ing le polynôme. Ainsi:

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} 
*) 

et cela fonctionne également pour ma méthode. Pour résumer, il suffit de coller Expand devant l'expression et avant de prendre le coefficient.

Answer 2

Je pense que la raison pour laquelle le code original est lent est que Coefficient fonctionne même avec de très grandes expressions - celles qui ne rentreraient pas dans la mémoire si elles étaient naïvement développées.

est ici le polynôme d'origine:

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

Voyez comment pour ne pas trop grand q, l'élargissement du polynôme prend beaucoup plus de mémoire et devient assez lent:

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}} 

Maintenant, nous allons définir le coefficient de 3 manières différentes et les temps

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} 

Donc, SeriesCoefficient est certainement le chemin à parcourir.À moins bien sûr que vous êtes un peu mieux à combinatoires que moi et vous connaissez les premier formules de partition suivantes (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}