GV/DT/PT/D4D2D0 invariants

Accompanying notebook for the article “Quantum Geometry, Stability and Modularity” [arxiv:2301.nnnnn]
by Sergei Alexandrov, Soheyla Feyzbakhsh, Albrecht Klemm, Boris Pioline and Thorsten Schimannek

ClearAll[pmax,GVTab,DTTab,PTTab,PTTabGv,GVTabExt,GVTabExt2,h1,h1fun,h1int];
SetDirectory[NotebookDirectory[]];

(* Download from http://www.th.physik.uni-bonn.de/Groups/Klemm/data.php, and save same directory as this notebook *)
<<GVDTPTlib.m

(* Download the datafile X*.m for your favorite hypergeometric CY3 from http://www.th.physik.uni-bonn.de/Groups/Klemm/data.php *)
<<X5.m

(* maximal genus in the table of GV invariants *)
gmaxGV=Length[GVTab]-1;
(* highest genus attainable with standard boundary conditions *)
gInt=gMaxInteg[kappa,CYreg];
(* maximal degree in the table of GV invariants *)
QmaxGV=Length[Transpose[GVTab]];
(* extract Fourier coefficients in generating series of D4D2D0 invariants *)
JTab=CoefficientList[h1int,q];
(* restore leading powers of q in vector valued generating series *)
h1=Table[h1int[[mu+1]] q^(-(kappa+c2 )/24+FractionalPart[mu^2/(2kappa )+mu  /2]),{mu,0,Length[h1int]-1}];

(* CYname, Euler number, H^3, c2(TY).H, effective regulator rho, maximal attainable genus, maximal available genus, maximal power of q *)
{CY,chi,kappa,c2,CYreg,QmaxGV,gInt,gmaxGV,NMax}

(* check CY condition and kappa value *)
{Plus@@CYwts-Plus@@CYmod,kappa-Times@@CYmod/Times@@CYwts}

(* compare polar part with naive ansatz (4.11) *)
Series[Take[h1-ZPolarNaive[kappa,c2,1,Table[0,{mu,0,kappa-1}]]/.repDT,Floor[kappa/2+1]],{q,0,0}]

(* predictions from naive ansatz (4.11) for non-polar terms *)
With[{dn=2},Take[ZPolarNaiveInt[kappa,c2,1,Table[dn,{mu,0,kappa-1}]]/.repDT,Floor[kappa/2+1]]]

(* Extra constraints for the direct integration method; increase dn until unknown coefficients appear *)
With[{dn=5},GVPrediction[kappa,CYreg,gInt+10]]

(* GV invariants saturating the Castelnuovo constraint, for degree multiple of kappa *)
Table[GVSaturating[kappa,c2,kappa k],{k,1,10}]

(* Table of GV[g,d] row=genus, column= degree; data from direct integration *)
GVTab//MatrixForm

(* Table of DT[d,n] row=degree, 1st column=nmin *)
DTTab//MatrixForm

(* Table of PT[d,n] row=degree, 1st column=nmin *)
PTTab//MatrixForm

(* Table of PT[d,n] row=degree, 1st column=nmin; computed from GVTab + unknown Gv[g,d] *)
PTTabGv//MatrixForm

(* Table of GV[g,d] row=genus, column= degree; data from GVTab + modular constraints *)
GVTabExt//MatrixForm

(*  Same as previous table, but different format; row= degree, 1st column= gMax[d]; data from direct integration + modularity *)
GVTabExt2//MatrixForm

(* check GVTabExt2 against known GV invariants *)
repGV={Gv[g_,m_]:>If[g>gMax[kappa,m]||m==0||g<0,0,If[g+1≤Length[GVTab],If[m≤Length[GVTab[[g+1]]],GVTab[[g+1,m]],Gv[g,m]],Gv[g,m]]]};
Table[Join[{m,gMax[kappa,m]},Table[If[NumericQ[GVTabExt2[[m,delta+2]]],GVTabExt2[[m,delta+2]]-Gv[gMax[kappa,m]-delta,m]/.repGV,GVTabExt2[[m,delta+2]]],{delta,0,5}]],{m,1,Length[GVTabExt2]}]/.repGV//MatrixForm

(* GVTabExt2 with 1st column=degree, and ? replaced by known GV invariants; if result depends on unknown PT, leave ? *)
repGV={Gv[g_,m_]:>If[g>gMax[kappa,m]||m==0||g<0,0,If[g+1≤Length[GVTab],If[m≤Length[GVTab[[g+1]]],GVTab[[g+1,m]],Gv[g,m]],Gv[g,m]]]};
Table[Join[{m,gMax[kappa,m]},Table[If[GVTabExt2[[m,delta+2]]==="?"||GVTabExt2[[m,delta+2]]==="",Gv[gMax[kappa,m]-delta,m]/.repGV,If[NumericQ[GVTabExt2[[m,delta+2]]],GVTabExt2[[m,delta+2]],"?"]],{delta,0,5}]],{m,1,Length[GVTabExt2]}]/.repGV//MatrixForm

Determination of PT and DT invariants from GV invariants

Qmax=Min[QmaxGV,Qmin[kappa,gmaxGV]-1]

NMax=100;
(* generating function of PT invariants *)
ZPTnew[QMax_,q_,y_]:=Exp[Sum[Sum[(((-1))^(g+1))GVTab[[g+1,Q]]Sum[(1/k)(q^((1-g)k)) (y^(Q k))(((1-(q^k)))^(2g-2)),{k,1,QMax}],{g,0,gMax[kappa,Q]}],{Q,1,QMax}]]/.q->-q;
(* y-expand the generating function of PT invariants *)
ZPTexpy=Simplify[Series[ZPTnew[Qmax,q,y],{y,0,Qmax}]];

(* q-expand each coefficient in y, after multiplying by the power of q corresponding to the Castelnuovo bound *)
ZPTexp=Table[Series[(q^(-MMin[kappa,i-1]))ZPTexpy[[3,i]],{q,0,NMax}],{i,1,Length[ZPTexpy[[3]]]}];
(* extract the coefficients of the expansion *)
PTTabsh=CoefficientList[ZPTexp,q];
(* add zeros to the first row to complete to a square table *)
PTTabsh[[1]]=Join[PTTabsh[[1]],Array[0 &,NMax]];
(* adds the first column encoding the shifts of the D0-charge *)
PTTab=Transpose[Join[{Table[-MMin[kappa,mu],{mu,0,Qmax}]},Transpose[PTTabsh]]];
MatrixForm[PTTab]

(* same for DT invariants *)

ZDTexp=Table[Series[MacMahon[NMax,-q]^chi (q^(-MMin[kappa,i-1]))ZPTexpy[[3,i]],{q,0,NMax}],{i,1,Length[ZPTexpy[[3]]]}];
(* extract the coefficients of the expansion *)
DTTabsh=CoefficientList[ZDTexp,q];
(* adds the first column encoding the shifts of the D0-charge *)
DTTab=Transpose[Join[{Table[-MMin[kappa,mu],{mu,0,Qmax}]},Transpose[DTTabsh]]];
MatrixForm[DTTab]

(* extending the table of GV invariants by unknown entries *)
GVtemp=Array[Gv[#1-1,#2] &, {Length[GVTab]+20,Length[Transpose[GVTab]]+10}];
GVtemp[[1;;Length[GVTab],1;;Length[Transpose[GVTab]]]]=GVTab;
Qmax=Qmax+2;
NMax=20;
(* generating function of PT invariants *)
ZPTnew[QMax_,q_,y_]:=Exp[Sum[Sum[(((-1))^(g+1))GVtemp[[g+1,Q]]Sum[(1/k)(q^((1-g)k)) (y^(Q k))(((1-(q^k)))^(2g-2)),{k,1,QMax}],{g,0,gMax[kappa,Q]}],{Q,1,QMax}]]/.q->-q;

(* y-expand the generating function of PT invariants *)
ZPTexpy=Simplify[Series[ZPTnew[Qmax,q,y],{y,0,Qmax}]];

(* q-expand each coefficient in y, after multiplying by the power of q corresponding to the Castelnuovo bound *)
ZPTexp=Table[Series[(q^(-MMin[kappa,i-1]))ZPTexpy[[3,i]],{q,0,NMax}],{i,1,Length[ZPTexpy[[3]]]}];
(* extract the coefficients of the expansion *)
PTTabsh=CoefficientList[ZPTexp,q];
(* add zeros to the first row to complete to a square table *)
PTTabsh[[1]]=Join[PTTabsh[[1]],Array[0 &,NMax]];
(* adds the first column encoding the shifts of the D0-charge *)
PTTabGv=Transpose[Join[{Table[-MMin[kappa,mu],{mu,0,Qmax}]},Transpose[PTTabsh]]];
MatrixForm[PTTabGv]

Determination of J invariants from modular generating functions at rank 1

(* the generating function is h1fun in X.m *)
h1fun

(* definition of modular functions - now part of GVDTPTlib.m *)
NMax=100;
E2[q_]:=1-24 Sum[n q^n/(1-q^n),{n,NMax}];
E4[q_]:=1+240 Sum[n^3 q^n/(1-q^n),{n,NMax}];
E6[q_]:=1-504 Sum[n^5q^n/(1-q^n),{n,NMax}];
eta[q_]:=q^(1/24)*(1+Sum[(((-1))^n)(q^(n(3n-1)/2)+q^(n(3n+1)/2)),{n,1,NMax}]);
Th[r_,kappa_,mu_,q_]:=Sum[(-1)^(kappa r^2n)q^(kappa r n^2/2),{n,-NMax-1+r/2+mu/(kappa r),NMax+r/2+mu/(kappa r)}];
dTh[r_,kappa_,mu_,q_]:=Sum[(kappa n/I) (-1)^(kappa r^2n)q^(kappa r n^2/2),{n,-NMax-1+r/2+mu/(kappa r),NMax+r/2+mu/(kappa r)}];

DThTab={Table[Series[If[EvenQ[kappa],Th[1,kappa,k,q],dTh[1,kappa,k,q]],{q,0,NMax}],{k,0, kappa-1}]};
wTheta=If[EvenQ[kappa],1/2,3/2];
Do[
AppendTo[DThTab,Series[q D[Last[DThTab],q]-wTheta/12 E2[q]Last[DThTab],{q,0,NMax}]];
wTheta+=2,{l,lmax}];

h1ser=Assuming[q>0,Series[ReplaceAll[h1fun,{Eta->eta[q],e4->E4[q],e6->E6[q],DdTh[p_]:>DThTab[[p+1]],DTh[p_]:>DThTab[[p+1]]}],{q,0,NMax}]];

(* removing fractional part of the powers of q *)
h1int=If[kappa==1,{q^((kappa +c2 )/24) h1ser},Array[q^((kappa +c2 )/24-FractionalPart[(#-1)^2/(2kappa )+(#-1) /2]) h1ser[[#]] &,kappa]]

(* check eta-product formula for mu=0, ell=0 *)
Assuming[q>0,Series[DThTab[[1,1]]/If[Mod[kappa,2]==0,2(-1)^(kappa/2)eta[q^(2kappa)]^2/eta[q^kappa],(-1)^((kappa-1)/2)kappa eta[q^kappa]^3],{q,0,NMax}]]

Compute D4D2D0 invariants with r=1 from Soheyla’s thm 1.1

(* Minimal values of the spectral flow parameter n *)
NTab=Array[nMin [kappa,#1-1,#2-1+MMin[kappa,#1-1]]&,{IntegerPart[kappa/2]+1,10}];
(* adds the first column encoding the shifts of the D0-charge *)
 NTab=Transpose[Join[{Table[-MMin[kappa,mu],{mu,0,IntegerPart[kappa/2]}]},Transpose[NTab]]];
MatrixForm[NTab]

(* D4D2D0 indices for minimal legal value of spectral flow parameter n *)
DTs=Table[Table[S2[kappa,mu,M,nMin[kappa,mu,M]],{M,MMin[kappa,mu],12+MMin[kappa,mu]}],{mu,0,kappa/2}]/.repPT;
DTs//MatrixForm
DTs/.repJ//MatrixForm

(* try if n-1 already produces the correct result *)
DTs1=Table[Table[S2Lemma[kappa,mu,M,nMin[kappa,mu,M]-1],{M,MMin[kappa,mu],12+MMin[kappa,mu]}],{mu,0,kappa/2}]/.repPT;
DTs1//MatrixForm
Simplify[DTs1/.repJ]//MatrixForm

(* table of (x,\alpha) values using n-1 units of spectral flow *)
Charges1=Table[Table[mumToxa[kappa,{mu,M},nMin[kappa,mu,M]-1],{M,MMin[kappa,mu],12+MMin[kappa,mu]}],{mu,0,kappa/2}];
Charges1//MatrixForm

GV invariants from D4-D2-D0 with r=1

(* approximately the minimal genus that can be treated by our method *)
gMin[kappa_,Q_]:=Floor[((Q^2)/(3 kappa))+((2Q)/3)+1];
(* the maximal degree which gives rise to the genus satisfying the Castelnuovo bound *)
QmaxGVg=Qmin[kappa,gmaxGV]

QMax=QmaxGVg+5;
dM=2;
ZGV[QMax_,x_,y_]:=Sum[((MoebiusMu[k])/k)Log[1+Sum[Sum[(PT[Q,M]/.repPTfromJ/.repJ/.repPT) (((-1))^M)(((-x))^(k M)) (y^(k Q)),{M,MMin[kappa,Q],Floor[-((Q^2)/(3 kappa))-((2 Q)/3)]+2dM}],{Q,1,QMax}]],{k,1,QMax}]
(* y-expand the generating function of PT invariants *)
ZGVexpy=Simplify[Series[ ZGV[QMax,x,y],{y,0,QMax}]];

GVTabExt=Array[0 &, {gMax[kappa,QMax]+1,QMax}];
GVTabExt2=Array["" &, {QMax,gMax[kappa,QMax]+2}];
Do[ZGVexp=ZGVexpy[[3,Q]];
GVTabExt2[[Q,1]]=gMax[kappa,Q];
Do[If[g>=Max[gMin[kappa,Q]-dM,0],
GVTabExt[[g+1,Q]]=Limit[(x^(g-1)) ZGVexp,x->0];
ZGVexp=Series[ZGVexp-GVTabExt[[g+1,Q]](x^(1-g))(((1+x))^(2(g-1))),{x,0,gMax[kappa,QMax]}],
GVTabExt[[g+1,Q]]="?"];GVTabExt2[[Q,gMax[kappa,Q]-g+2]]=GVTabExt[[g+1,Q]],{g,gMax[kappa,Q],0,-1}],{Q,1,QMax}];
MatrixForm[GVTabExt]
MatrixForm[GVTabExt2]

PT and DT invariants from D4-D2-D0 with r=1

muMax=Length[PTTab]+8;
NMax=-MMin[kappa,muMax]+10;
PTTab1=Array[0 &, {muMax+1,NMax+1}];
PTTab2=Array["" &, {muMax+1,NMax+2}];
Do[PTTab2[[mu+1,1]]=-MMin[kappa,mu];
Do[PTTab1[[mu+1,n+1]]=PT[mu,n+MMin[kappa,muMax]]/.repPTfromJ/.repJ/.repPT;
PTTab2[[mu+1,n+2]]=PT[mu,n+MMin[kappa,mu]]/.repPTfromJ/.repJ/.repPT,{n,0,NMax}],{mu,0,muMax}];
MatrixForm[PTTab1]
MatrixForm[PTTab2]

Take[PTTab2,{1,Length[PTTab2]},{1,7}]//MatrixForm