Skip to main content

numerics - Eisenstein Series in Mathematica?


Mathematica doesn't seem to have built-in tools to deal with the Eisenstein series:


$$\begin{align*} E_{2}(\tau)&= 1-24 \sum_{n=1}^{\infty} \frac{n e^{2 \pi i n \tau}}{1-e^{2 \pi i n \tau}}\\ E_{4}(\tau)&= 1+240 \sum_{n=1}^{\infty} \frac{n^{3} e^{2 \pi i n \tau}}{1-e^{2 \pi i n \tau}} \end{align*}$$


I'm wondering what is the best way to deal with this. Just messing around, informally, on Wolfram, it seems like these series all converge pretty fast. Can I carry out the sums manually in Mathematica including a small number of terms? Or is there a better way? I'm worried this is prone to severe inaccuracy for $\Im(\tau)$ either large or small, both cases I'm interested in.


If it simplifies anything, I only need the cases $\Re(\tau) \in \mathbb{Z}$ where the series outputs real numbers.



Answer



Since EllipticTheta[] is a built-in function, and since the Eisenstein series $E_4(q)$ and $E_6(q)$ are expressible in terms of theta functions (I use the nome $q$ as the argument in this answer, but you can convert to your convention by using the relation with the period ratio $\tau$: $q=\exp(2\pi i \tau)$), and since the higher-order Eisenstein series (note that they are only defined for even orders!) can be generated from $E_4(q)$ and $E_6(q)$ through a recurrence (see e.g. Apostol's book), it is relatively straightforward to write Mathematica routines for these functions:



SetAttributes[EisensteinE, {Listable, NHoldFirst}];

EisensteinE[4, q_] := (EllipticTheta[2, 0, q]^8 + EllipticTheta[3, 0, q]^8 +
EllipticTheta[4, 0, q]^8)/2

EisensteinE[6, q_] := With[{q2 = EllipticTheta[2, 0, q]^4,
q3 = EllipticTheta[3, 0, q]^4,
q4 = EllipticTheta[4, 0, q]^4},
(q2 + q3) (q3 + q4) (q4 - q2)/2


EisensteinE[n_Integer?EvenQ, q_] /; n > 2 := (6/((6 - n) (n^2 - 1) BernoulliB[n]))
Sum[Binomial[n, 2 k + 4] (2 k + 3) (n - 2 k - 5)
BernoulliB[2 k + 4] BernoulliB[n - 2 k - 4]
EisensteinE[2 k + 4, q] EisensteinE[n - 2 k - 4, q], {k, 0, n/2 - 4}]

Here are a few examples:


(* "equianharmonic case" *)
{ω1, ω3} = {1, (1 + I Sqrt[3])/2};
N[WeierstrassInvariants[{ω1, ω3}]] // Quiet // Chop
{0, 12.825381829368068}


2 {60, 140} Zeta[{4, 6}] EisensteinE[{4, 6}, Exp[I π ω3/ω1]]/(2 ω1)^{4, 6}
// N // Chop
{0, 12.825381829368068}

(* "lemniscatic case" *)
{ω1, ω3} = {1, I};
N[WeierstrassInvariants[{ω1, ω3}]] // Quiet // Chop
{11.817045008077123, 0}


2 {60, 140} Zeta[{4, 6}] EisensteinE[{4, 6}, Exp[I π ω3/ω1]]/(2 ω1)^{4, 6}
// N // Chop
{11.817045008077123, 0}

Using techniques similar to the one used in this answer, here are domain-colored plots of $E_4(q)$ (left) and $E_6(q)$ (right) over the unit disk, using the DLMF coloring scheme:


domain-colored plots of the Eisenstein series




Now, one may ask: what about $E_2(q)$? This function is what is termed as a "quasi-modular" form, whose behavior with respect to modular transformations is completely different from the other $E_{2k}(q)$. Due to this unusual state of affairs (i.e. not expressible entirely in terms of theta functions), one needs a different formula for $E_2(q)$; one useful formula can be found hidden deep within Abramowitz and Stegun:


EisensteinE[2, q_] := With[{q3 = EllipticTheta[3, 0, q]^2}, 6/π
EllipticE[InverseEllipticNomeQ[q]] q3 -

q3^2 - EllipticTheta[4, 0, q]^4]

Test:


Series[EisensteinE[2, q], {q, 0, 12}]
1 - 24 q^2 - 72 q^4 - 96 q^6 - 168 q^8 - 144 q^10 - 288 q^12 + O[q]^13

1 - Sum[24 DivisorSigma[1, k] q^(2 k), {k, 1, 6}]
1 - 24 q^2 - 72 q^4 - 96 q^6 - 168 q^8 - 144 q^10 - 288 q^12

Unfortunately, altho this version is great for symbolic use, it is not too good for numerical evaluation, as can be seen from the following attempt to generate a domain-colored plot from it:



wrong domain-colored plot of E2


The relatively complicated branch cut structure is apparently inherited from the branch cuts of the complete elliptic integral of the second kind $E(m)$ not being canceled out by the inverse nome.


Thus, I shall present another routine for numerically evaluating $E_2(q)$, based on recursing the quasi-modular relation (note the use of $\tau$ instead of $q$)


$$E_2\left(-\frac1{\tau}\right)=\tau^2 E_2(\tau)-\frac{6i\tau}{\pi}$$


before the actual numerical evaluation of the series:


e2[zz_ /; (InexactNumberQ[zz] && Im[zz] > 0)] :=
Block[{τ = SetPrecision[zz, 1. Precision[zz]], r = False, f, k, pr, q, qp, s},
τ -= Round[Re[τ]]; pr = Precision[τ];
If[7 Im[τ] < 6,
r = True; f = e2[SetPrecision[-1/τ, pr]],

q = SetPrecision[Exp[2 π I τ], pr]; f = s = 0; qp = 1;
k = 0;
While[k++; qp *= q; f = s + k qp/(1 - qp); s != f, s = f];
f = 1 - 24 f];
If[r, (f/τ + 6 I/π)/τ, f] /; NumberQ[f]]

EisensteinE[2, q_?InexactNumberQ] :=
If[q == 0, N[1, Internal`PrecAccur[q]], e2[Log[q]/(I π)]]

(Note that the subroutine e2[] actually takes the period ratio $\tau$ as the argument; if your preferred convention is to use $\tau$ instead of $q$, you can make that the main routine and skip the conversion to $q$ altogether.)



This now gives a proper-looking plot:


domain-colored plot of E2


(Thanks to მამუკა ჯიბლაძე for convincing me to look further into this.)




Finally, if you prefer the function $G_{2k}(q)$, here is the corresponding formula:


EisensteinG[n_Integer?EvenQ, q_] := 2 Zeta[n] EisensteinE[n, q]

Comments

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...