Rank 0 DT invariants from PT/GV

ClearAll[pmax,lmax,lmax2,h1,GVTab,PTTab,DTTab];
SetDirectory[NotebookDirectory[]];
(* choose your favorite CICY *)
<<X44.m
{CY,chi,kappa,c2}

(* maximal degrees *)
{Length[Transpose[GVTab]],Length[DTTab]-2,Length[PTTab]-2}

(* maximal ch3 *)
{Map[Length,DTTab]-pmax-1,Map[Length,PTTab]-pmax-1}

(* conjectural maximal genus for given degree *)
gCastel[mu_]:=Floor[mu^2/(2kappa)+mu/2+1];repDT={DT[mu_,n_]:>If[n<-mu^2/(2kappa)-mu/2,0,If[mu+2<=Length[DTTab],If[n+pmax+1<=Length[DTTab[[mu+2]]]&&n+pmax>=0,DTTab[[mu+2,n+pmax+1]],DT[mu,n]],DT[mu,n]]]};
repPT={PT[mu_,n_]:>If[n<-mu^2/(2kappa)-mu/2,0,If[mu+2<=Length[PTTab],If[n+pmax+1<=Length[PTTab[[mu+2]]]&&n+pmax>=0,PTTab[[mu+2,n+pmax+1]],PT[mu,n]],PT[mu,n]]]};
repGV={Gv[g_,m_]:>If[g>m^2/(2kappa)+m/2+1||m==0,0,If[g+1<=Length[GVTab],If[m<=Length[GVTab[[g+1]]],GVTab[[g+1,m]],Gv[g,m]],Gv[g,m]]]};
(* valid only for m close to Castelnuovo bound *)
repPTApprox={PT[b_,m_]:>Sum[Binomial[2g-2,g-1-m]Gv[g,b],{g,1,Floor[b^2/(2kappa)+b/2+1]}]/.repGV};
(* same but do not evaluate GV invariants *)
repPTApprox0={PT[b_,m_]:>Sum[Binomial[2g-2,g-1-m]Gv[g,b],{g,1,Floor[b^2/(2kappa)+b/2+1]}]};

(* the vector of shifts of the charge n *)
nShift=Array[IntegerPart[(#-1)^2/(2kappa )+(#-1) /2] &,kappa]

(* minimal value of n for Feyzbakhsh Thm 1.2 to be applicable with M=0 *)
nMin[mu_]:=Ceiling[-(1/6)+(7/(6 kappa))+(mu/2)-(mu/kappa)+((mu^2)/(2 kappa))]+
If[kappa==1 || kappa==7|| (kappa==8&&mu==0),1,0];
mun[mu_,n_]:=mu+(n+1)kappa;
mn[mu_,m_,n_]:=m-(n+1)mu-(kappa/2)(n+1)(n+2);
ChiO1[mu_,M_,n_]:=(kappa/2)n(n+1)+n mu-M+(kappa/6)+(c2/12);
(* answer from Soheyla's Thm 1.2, for r=1 *)
S1[mu_,M_,n_]:=((((-1))^(ChiO1[mu,M,n]+1))/(ChiO1[mu,M,n]))PT[mun[mu,n],mn[mu,M,n]];

GVTab//MatrixForm

DTTab//MatrixForm

PTTab//MatrixForm

(* check if leading polar coefficient stabilizes *)
With[{mu=0},Table[S1[mu,0,n],{n,0,nMin[mu]+2}]]/.repPTApprox

With[{mu=0},Table[S1[mu,0,n],{n,0,nMin[mu]+2}]]/.repPT

(* check if coefficients stabilize *)
Table[Table[Table[S1[mu,M,n],{n,0,nMin[mu]+M+1}],{M,-nShift[[mu+1]],3}],{mu,0,kappa/2}]/.repPT

(* for minimal value of n *)
Table[Table[S1[mu,M,nMin[mu]+M],{M,-nShift[[mu+1]],3}],{mu,0,kappa/2}]/.repPTApprox

(* try if n-1 already produces the correct result *)
Table[Table[S1[mu,M,nMin[mu]+M-1],{M,-nShift[[mu+1]],3}],{mu,0,kappa/2}]/.repPTApprox

(* try if n-2 already produces the correct result *)
Table[Table[S1[mu,M,nMin[mu]+M-2],{M,-nShift[[mu+1]],3}],{mu,0,kappa/2}]/.repPTApprox

(* DT and PT invariants from the generating function *)

(* definition of modular functions *)
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}];

(* expansion of the generating function *)
h1fun
h1ser=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]]

(* constructing the table of coefficients *)
JTab=CoefficientList[h1int,q];

(* spectral flow transformation bringing D2 brane charge to the interval [0,κ-1] *)
SFmu[κ_,μ_]:=Module[{x= IntegerPart[μ/κ]},μ-κ x];
SFM[κ_,μ_,M_]:=Module[{x= IntegerPart[μ/κ]},M+μ x+(κ/2)x(1-x)];
(* PT from J invariants using Soheyla's formula for r=1 *)
ChiJ[mu_,m_]:=- mu-m+(kappa/6)+(c2/12);
PTfromJ={PT[mu_,n_]:>If[n<-mu^2/(2kappa)-mu/2,0,If[mu+2<=Length[PTTab]&& n+pmax+1<=Length[PTTab[[mu+2]]]&&n+pmax>=0,PTTab[[mu+2,n+pmax+1]],muJ=SFmu[kappa,mu];nJ=SFM[kappa,mu,n];If[nJ+nMin[muJ]<=IntegerPart[mu/kappa], (((-1))^(ChiJ[muJ,nJ]+1))ChiJ[muJ,nJ]J[muJ,nJ],PT[mu,n]]]]};
repJ={J[mu_,n_]:>If[n<-nShift[[mu+1]],0,If[mu+1<=Length[JTab]&& n+1<=Length[JTab[[mu+1]]]-nShift[[mu+1]],JTab[[mu+1,n+nShift[[mu+1]]+1]],J[mu,n]]]};

Pl=Plot[{-mu^2/(2kappa)-mu/2,Length[PTTab[[1]]]-pmax-1,-pmax, (10^10)(mu-Length[PTTab]),IntegerPart[mu/kappa]-nMin[SFmu[kappa,mu]]-SFM[kappa,mu,0]},{mu,0,10kappa},PlotStyle->{Blue,Red,Green,Magenta,Orange}]
Export["bounds.gif",Pl];

(* evaluation for r=2 *)

(* various definitions *)
(* low limit for D2-brane charge of the constituents *)
LBmu[κ_,μ_,M_,n_]:=((κ((n+1)μ-3M+κ(4- (n^2))))/(2(μ+2κ(n+2))));
(* χ((Subscript[O, X])(-n),v) *)
ChiO[κ_,c_,μ_,M_,n_]:=κ n(n+2)+n μ-M+(4/3)κ+(c/6);
(* prefactor *)
Fac[κ_,c_,μ_,M_,n_]:=((((-1))^(ChiO[κ,c,μ,M,n]+1))/(ChiO[κ,c,μ,M,n]));
(* coefficients in the sum *)
Chi[κ_,c_,μ_,μ2_,M2_,n_]:=(n+2)μ2-μ-M2+(c/12)+((κ )/6)+(κ/2)(n-1)(n+2);
(* spectral flow transformation bringing D2 brane charge to the interval [0,κ-1] *)
(* SFmu[κ_,μ_]:=Module[{x= IntegerPart[μ/κ]},If[FractionalPart[μ/κ]>1/2,x=x+1]; μ-κ x];
SFM[κ_,μ_,M_]:=Module[{x= IntegerPart[μ/κ]},If[FractionalPart[μ/κ]>1/2, x=x+1] ;M+μ x+(κ/2)x(1-x)]; *)

(* different contributions from Soheyla's Thm 1.2 for r=2 corresponding to 0≤(∑_(i=1)^N)(Subscript[k, i])≤2 *)
(* contribution with N=0 *)
SPT0[κ_,c_,μ_,M_,n_]:=Fac[κ,c,μ,M,n]PT[μ+2κ(n+2),M-(n+2)μ-κ(n+2)(n+4)];

(* contribution with N=1 and (Subscript[k, 1])=1 *)
(* upper bound on D0-brane charge *)
UBm1[κ_,μ_,M_,μ2_,n_]:=M+(1/(2κ))(((μ-μ2))^2)+(3/2)(μ-μ2);
(* the contribution *)
SPT1[κ_,c_,μ_,M_,n_]:=Fac[κ,c,μ,M,n]Sum[Sum[(((-1))^(Chi[κ,c,μ,μ2,M2,n]))Chi[κ,c,μ,μ2,M2,n] J[μ2,M2]PT[μ-μ2+κ(n+2),M-M2-(n+1)(μ-μ2)-(κ/2)(n+2)(n+3)],{M2,Ceiling[(κ/8)],Floor[UBm1[κ,μ,M,μ2,n]]}],{μ2,Ceiling[LBmu[κ,μ,M,n]],Floor[μ+κ(n+2)]}];
(* the contribution after spectral flow *)
SPT1sf[κ_,c_,μ_,M_,n_]:=Fac[κ,c,μ,M,n]Sum[Sum[(((-1))^(Chi[κ,c,μ,μ2,M2,n]))Chi[κ,c,μ,μ2,M2,n] J[SFmu[κ,μ2],SFM [κ,μ2,M2]]PT[μ-μ2+κ(n+2),M-M2-(n+1)(μ-μ2)-(κ/2)(n+2)(n+3)],{M2,Ceiling[(κ/8)],Floor[UBm1[κ,μ,M,μ2,n]]}],{μ2,Ceiling[LBmu[κ,μ,M,n]],Floor[μ+κ(n+2)]}];

(* contribution with N=1 and (Subscript[k, 1])=2 *)
(* upper bound on D0-brane charge *)
UBm2[κ_,μ_,M_,μ2_,n_]:=(1/2)M+(1/(4κ))(((μ-2μ2))^2)+((3-2n)/4)(μ-2μ2)-((κ n)/2);
(* the contribution *)
SPT2[κ_,c_,μ_,M_,n_]:=Fac[κ,c,μ,M,n]Sum[Sum[(((Chi[κ,c,μ,μ2,M2,n] J[μ2,M2]))^2)PT[μ-2μ2+κ,M-2M2-n(μ-2μ2)-κ(n+1)],{M2,Ceiling[(κ/8)],Floor[UBm2[κ,μ,M,μ2,n]]}],{μ2,Ceiling[LBmu[κ,μ,M,n]],Floor[(μ/2)+(κ/2)]}];
(* the contribution after spectral flow *)
SPT2sf[κ_,c_,μ_,M_,n_]:=Fac[κ,c,μ,M,n]Sum[Sum[(((Chi[κ,c,μ,μ2,M2,n] J[SFmu[κ,μ2],SFM [κ,μ2,M2]]))^2)PT[μ-2μ2+κ,M-2M2-n(μ-2μ2)-κ(n+1)],{M2,Ceiling[(κ/8)],Floor[UBm2[κ,μ,M,μ2,n]]}],{μ2,Ceiling[LBmu[κ,μ,M,n]],Floor[(μ/2)+(κ/2)]}];

(* contribution with N=2 and (Subscript[k, 1])=(Subscript[k, 2])=1 *)
(* the coefficients in the sum *)
Chi1[κ_,c_,μ_,μ2_,M2_,μ3_,n_]:=If[μ2≤μ3,(n+2)μ2-μ-M2+(c/12)+((κ )/6)+(κ/2)(n-1)(n+2),(n+1)μ2+μ3-μ-M2+(c/12)+((κ )/6)+(κ/2)(n-1)(n+2)];
Chi2[κ_,c_,μ_,μ2_,μ3_,M3_,n_]:=If[μ2≤μ3,(n+2)μ3-μ-M3+(c/12)+((κ )/6)+(κ/2)(n-1)(n+2),(n+1)μ3+μ2-μ-M3+(c/12)+((κ )/6)+(κ/2)(n-1)(n+2)];
(* upper bound on D0-brane charge *)
UBm11[κ_,μ_,M_,μ2_,μ3_,n_]:=M+(1/κ)(((μ-μ2-μ3))^2)+((3-2n)/2)(μ-μ2-μ3)-κ n;
(* the contribution *)
SPT11[κ_,c_,μ_,M_,n_]:=Fac[κ,c,μ,M,n]Sum[Sum[Sum[Sum[(((-1))^(Chi1[κ,c,μ,μ2,M2,μ3,n]+Chi2[κ,c,μ,μ2,μ3,M3,n]))Chi1[κ,c,μ,μ2,M2,μ3,n]Chi2[κ,c,μ,μ2,μ3,M3,n]J[μ2,M2]J[μ3,M3]PT[μ-μ2-μ3+κ,M-M2-M3-n(μ-μ2-μ3)-κ(n+1)],{M2,Ceiling[(κ/8)],Floor[UBm11[κ,μ,M,μ2,μ3,n]]-M3}],{M3,Ceiling[(κ/8)],Floor[UBm11[κ,μ,M,μ2,μ3,n]]-Ceiling[(κ/8)]}],{μ2,Ceiling[LBmu[κ,μ,M,n]],Floor[μ+κ]-μ3}],{μ3,Ceiling[LBmu[κ,μ,M,n]],Floor[μ+κ]-Ceiling[LBmu[κ,μ,M,n]]}];
(* the contribution after spectral flow *)
SPT11sf[κ_,c_,μ_,M_,n_]:=Fac[κ,c,μ,M,n]Sum[Sum[Sum[Sum[(((-1))^(Chi1[κ,c,μ,μ2,M2,μ3,n]+Chi2[κ,c,μ,μ2,μ3,M3,n]))Chi1[κ,c,μ,μ2,M2,μ3,n]Chi2[κ,c,μ,μ2,μ3,M3,n]J[SFmu[κ,μ2],SFM [κ,μ2,M2]]J[SFmu[κ,μ3],SFM [κ,μ3,M3]]PT[μ-μ2-μ3+κ,M-M2-M3-n(μ-μ2-μ3)-κ(n+1)],{M2,Ceiling[(κ/8)],Floor[UBm11[κ,μ,M,μ2,μ3,n]]-M3}],{M3,Ceiling[(κ/8)],Floor[UBm11[κ,μ,M,μ2,μ3,n]]-Ceiling[(κ/8)]}],{μ2,Ceiling[LBmu[κ,μ,M,n]],Floor[μ+κ]-μ3}],{μ3,Ceiling[LBmu[κ,μ,M,n]],Floor[μ+κ]-Ceiling[LBmu[κ,μ,M,n]]}];

(* evalutation of DT invariant *)
DTr2=With[{mu=0,M=1,n=2},
SPT0[kappa,c2,mu,M,n]+SPT1sf[kappa,c2,mu,M,n]+SPT2sf[kappa,c2,mu,M,n]+SPT11sf[kappa,c2,mu,M,n]]
DTr2J=DTr2/.PTfromJ
DTr2J/.repJ