5
$\begingroup$

I am working on some problem in physics/math in which I need a series expansion of a certain function, that is defined as an infinite product. I truncate this product to program it. The relevant part of my code is given by

\[Eta][q_] := q^(1/24)*QPochhammer[q, q]; 
\[Theta]1[q_, y_] := EllipticTheta[1, (1/(2*I))*Log[y], q^(1/2)]; 
\[Theta]2[q_, y_] := EllipticTheta[2, (1/(2*I))*Log[y], q^(1/2)]; 
\[Theta]3[q_, y_] := EllipticTheta[3, (1/(2*I))*Log[y], q^(1/2)]; 
\[Theta]4[q_, y_] := EllipticTheta[4, (1/(2*I))*Log[y], q^(1/2)]; 

\[Phi][q_, y_] := 8*((\[Theta]2[q, y]/\[Theta]2[q, 1])^2 + (\[Theta]3[q, y]/\[Theta]3[q, 1])^2 + (\[Theta]4[q, y]/\[Theta]4[q, 1])^2)

P\[Phi] = Normal[(Series[#1, {q, 0, 50}, {y, 0, 50}] & )[Assuming[y > 0 && u > 0, 
      Simplify[TrigToExp[Series[\[Phi][q, y], {q, 0, 50}]]]]]]; 

o = Exponent[P\[Phi], y, Min]

cc = CoefficientList[P\[Phi]/y^o, {q, y}]; 

\[CapitalPhi][p_, q_, y_] := p*q*y*Product[(1 - p^m*q^n*y^l)^cc[[m*n + 1,l - o + 1]], {m, 1, 6}, {n, 1, 6}, 
     {l, o, -o}]*Product[(1 - p^m*q^n*y^l)^cc[[m*n + 1,l - o + 1]], {m, 0, 0}, {n, 1, 6}, {l, o, -o}]*
    Product[(1 - p^m*q^n*y^l)^cc[[m*n + 1,l - o + 1]], {m, 1, 6}, {n, 0, 0}, {l, o, -o}]*
    Product[(1 - p^m*q^n*y^l)^cc[[m*n + 1,l - o + 1]], {m, 0, 0}, {n, 0, 0}, {l, o, -1}]; 

Normal[(Series[#1, {p, 0, 6}, {q, 0, 6}, {y, 0, 20}] & )[Assuming[y > 0 && u > 0, 
    Simplify[TrigToExp[Series[\[CapitalPhi][p, q, y], {p, 0, 6}, {q, 0, 6}]]]]]]

Note that P\[Phi] contains negative powers of $y$. That's why, when evaluating the coefficients of this Laurent series, I multiply by the $y^{-o}$, to shift the powers of $y$ to be all positive. Only then can the CoefficientList be used.

\[CapitalPhi] is the function I am interested in expanding. The rest of the code I hope speaks for itself The twice appearance of series is to have mathematica expand in such a way that it organizes the expression nicely, e.g. $p(q(y^2+y+...) + q^2 (\text{pol}(y))+ ...)) + p^2(...)$

I am interested in speeding up the code, as at the moment taking getting to order 7 in $p$ and $q$ is taking an hour or so. Any help would be much appreciated.

Note that the provided piece of code runs up to order 6 in $p$ and $q$.To expand to higher order, not only should I change the order of Series in the last line, but also the range of $m,n$ in the definition of \[CapitalPhi].

$\endgroup$
  • $\begingroup$ Do you need it to 7th order in all variables? Or would retaining p^7 and q^7 but losing p^4 q^4 do? The expansion is obviously much smaller in the latter case. $\endgroup$ – mikado Jun 19 '17 at 20:32
  • $\begingroup$ The image of your code is very low resolution and difficult to read. Could you edit your answer by formatting your code in code blocks? See this guide for more advice. $\endgroup$ – jjc385 Jun 19 '17 at 20:41
  • $\begingroup$ @mikado yes I kind of do. My question is more if there is some quicker way of implementing these products over large amount of factors $\endgroup$ – sam Jun 19 '17 at 21:21
  • 2
    $\begingroup$ You need to provide code that works. For instance: 1. Provide a sample cc variable. 2. Typo: {l, -6, , 6} in the first product should be {l, -6, 6}. 3. Phi[p, q, y] is identically 0 because of the m=0, n=0, l=0 term in the last product. Please fix these to provide working code. You should be able to quit the kernel, run your provided code, and have sensible output. $\endgroup$ – Carl Woll Jun 19 '17 at 22:54
  • 1
    $\begingroup$ I think you can insert the Series inside of the Product: \[CaptialPhi][p_, q_, y_] := p q y Product[Series[.., {p, 0, 6}, {q, 0, 6}, {y, 0, 20}], {m, 6}, {n, 6}, {l, o, -o}] .. $\endgroup$ – Carl Woll Jun 20 '17 at 16:32
2
$\begingroup$

Using a product of Series expressions will be much faster than finding the Series of the product. So, the following is much faster:

term[m_,n_,l_] := Series[
    (1-p^m q^n y^l)^cc[[m n+1, l-o+1]],
    {p, 0, 6}, {q, 0, 6}, {y, 0, 20}
]

Φ[p_,q_,y_] := Times[
    p, q, y,
    Product[term[m,n,l], {m,1,6},{n,1,6},{l,o,-o}],
    Product[term[m,n,l], {m,0,0},{n,1,6},{l,o,-o}],
    Product[term[m,n,l], {m,1,6},{n,0,0},{l,o,-o}],
    Product[term[m,n,l], {m,0,0},{n,0,0},{l,o,-1}]
]

res = Φ[p, q, y]; //Timing
res //Short //TeXForm

{0.267555, Null}

$\left(\left(\frac{1}{y}-2+y+O\left(y^{22}\right)\right) q+\left(-\frac{2}{y^2}-\frac{16}{y}+36-16 y-2 y^2+O\left(y^{20}\right)\right) q^2+\langle\langle 5\rangle\rangle +O\left(q^8\right)\right) p+\langle\langle 6\rangle\rangle +O\left(p^8\right)$

$\endgroup$
  • $\begingroup$ Thanks again, it was quite helpful. I guess it makes sense that series first and then product is quicker, since the number of terms grows exponentially with cc in the product, so first expanding it greatly reduces the number of terms taken in consideration, I guess. $\endgroup$ – sam Jun 21 '17 at 8:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.