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].

Improve this question
$\endgroup$
10
  • $\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, 2017 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, 2017 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, 2017 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, 2017 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, 2017 at 16:32

1 Answer 1

Reset to default
3
$\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)$

Improve this answer
$\endgroup$
1
  • $\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, 2017 at 8:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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