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$ Commented 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$ Commented 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$ Commented 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$ Commented 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$ Commented 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$ Commented Jun 21, 2017 at 8:01

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.