(* ::Package:: *) (* table of CY, chi,kappa, c2, type, reg *) LiCY = {{"X5", -200, 5, 50, "F", 5}, {"X6", -204, 3, 42, "F", 6}, {"X8", -296, 2, 44, "F", 8}, {"X10", -288, 1, 34, "F", 10}, {"X43", -156, 6, 48, "F", 3}, {"X44", -144, 4, 40, "K", 4}, {"X62", -256, 4, 52, "C", 6}, {"X64", -156, 2, 32, "F", 4}, {"X66", -120, 1, 22, "K", 6}, {"X33", -144, 9, 54, "K", 3}, {"X42", -176, 8, 56, "C", 4}, {"X322", -144, 12, 60, "C", 4}, {"X2222", -128, 16, 64, "M", 2}, {"RodlandGrassmannian", -98, 42, 84, "?", 1}, {"RodlandPfaffian", -98, 14, 56, "?", 1}, {"ReyeCongrX", -50, 35, 50, "?", 1}, {"ReyeCongrY", -50, 10, 40, "?", 1}}; (* Castelnovo upper bound on the genus of GV invariants for fixed degree *) gMax[kappa_, mu_] := Floor[mu^2/(2 kappa) + mu/2 + 1]; (* Castelnovo lower bound on the degree of GV invariants for fixed genus *) Qmin[kappa_, g_] := Ceiling[-kappa/2 + 1/2 Sqrt[kappa (8 (g - 1) + kappa)]]; (* nb of holomorphic ambiguities at genus g, assuming Castelnuovo \ vanishing and GV at maximal genus *) NbAmbiguities[kappa_, reg_, g_] := Max[0, Floor[2 (g - 1)/reg] - Floor[-kappa/2 + 1/2 Sqrt[kappa (8 (g - 1) + kappa)]]]; (* maximal genus attainable by direct integration, using bc and Castelnuovo vanishing + saturating data *) gMaxInteg[kappa_, reg_] := Module[{g}, g = Floor[kappa reg^2/2 - kappa reg/2 + 1]; While[NbAmbiguities[kappa, reg, g] <= 0, g += 1]; g - 1]; (* Additional conditions from GV invariants predicted by modularity *) GVPredictionOld[kappa_, reg_, gm_] := Module[{gmax}, gmax = gMaxInteg[kappa, reg]; If[gm <= gmax, Print["No ambiguities up to genus ", gmax]; {}, Print["Number of ambiguities up to genus ", gm, ":", Table[{g, NbAmbiguities[kappa, reg, g]}, {g, gmax + 1, gm}]]; Flatten[ Table[ Table[ Ngd[g, d] -> GVTabExt[[g + 1, d]], {d, Qmin[kappa, g], Qmin[kappa, g] + NbAmbiguities[kappa, reg, g] - 1 + If[Mod[Qmin[kappa, g], kappa] == 0, 1, 0]}], {g, gmax + 1, gm}]]] ]; GVPrediction[kappa_, reg_, gm_] := Module[{gmax}, gmax = gMaxInteg[kappa, reg]; If[gm <= gmax, Print["No ambiguities up to genus ", gmax]; {}, Print["Number of ambiguities up to genus ", gm, ":", Table[{g, NbAmbiguities[kappa, reg, g]}, {g, gmax + 1, gm}]]; Flatten[ Table[ Table[ Ngd[g, d] -> GVTabExt[[g + 1, d]], {d, Qmin[kappa, g], Qmin[kappa, g] + NbAmbiguities[kappa, reg, g] - 1 + If[g==gMax[kappa,Qmin[kappa,g]], 1, 0]}], {g, gmax + 1, gm}]]] ]; GVPredictionDelta[kappa_, reg_, gm_] := Module[{gmax}, gmax = gMaxInteg[kappa, reg]; If[gm <= gmax, Print["No ambiguities up to genus ", gmax]; {}, Print["Number of ambiguities up to genus ", gm, ":", Table[{g, NbAmbiguities[kappa, reg, g]}, {g, gmax + 1, gm}]]; ListPlot[Flatten[Table[ Table[ {g,(gMax[kappa,d]-g)/kappa}, {d, Qmin[kappa, g], Qmin[kappa, g] + NbAmbiguities[kappa, reg, g] - 1 + If[g==gMax[kappa,Qmin[kappa,g]], 1, 0]}], {g, gmax + 1, gm}],1],PlotStyle->Blue]] ]; (* Castelnuovo bound on D0-charge for PT invariants *) MMin[kappa_, mu_] := Ceiling[-(mu^2/(2 kappa)) - mu/2]; (* action of the spectral flow *) mun[kappa_, mu_, n_] := mu + n kappa; mn[kappa_, mu_, M_, n_] := M - n mu - kappa/2 (n^2 + n); (* from (mu,m) to (x,alpha) *) mumToxa[kappa_, {mu_, m_}] := {mu/kappa, -3/2 m/mu}; mumToxa[kappa_,{mu_, M_}, n_] := Module[{Mun, Mn}, Mun = mun[kappa, mu, n]; Mn = mn[kappa, mu, M, n]; If[(-((3 Mn)/(2 Mun)))^2 > 2 (Mun/kappa), {Mun/kappa, -((3 Mn)/(2 Mun))}, {}]]; (* from (x,alpha) to (x,delta) *) xaToxdelta[{x_, alpha_}] := {x, -2/3 x (alpha - 3/4 (x + 1))}; (* spectral flow action on (x,alpha) *) xan[x_, alpha_, n_] := {n + x, (4 alpha x + 3 n (1 + n + 2 x))/( 4 (n + x))}; (* spectral flow transformation bringing D2 charge to interval [0,\[Kappa]/2] *) SFmu[kappa_, mu_] := Module[{x = Round[mu/kappa]}, If[kappa x > mu, kappa x - mu , mu - kappa x]]; SFM[kappa_, mu_, M_] := Module[{x = Round[mu/kappa]}, If[kappa x > mu, M + mu x + kappa/2 x (1 - x) - (kappa x - mu), M + mu x + kappa/2 x (1 - x)]]; (* arithmetic genus chi(O(rD)) *) ChiO[kappa_, c2_, r_] := 1/6 kappa r^3 + c2/12 r; (* Euler characteristic of divisor *) ChiD[kappa_, c2_, r_] := kappa r^3 + c2 r; (* GV saturating Castelnuovo bound for mu=0 mod kappa *) GVSaturating[kappa_, c2_, mu_] := Module[{n}, If[Mod[mu, kappa] != 0, "?", n = mu/kappa; If[n >= (7 - kappa)/6/kappa + 2, (-1)^(kappa n (n - 1)/2) (1/2 kappa n (n - 1) + ChiO[kappa, c2, 1]) ChiO[kappa, c2, 1], "?"]]]; GVSubSaturating[kappa_,c2_,J1_,mu_]:=Module[{n,chiD},If[Mod[mu,kappa]!=0,"?",n=mu/kappa;chiD=ChiO[kappa,c2,1];If[n>=0(7-kappa)/6/kappa+2,(-1)^(kappa n (n-1)/2)(-1/2kappa^2n^4chiD-1/2kappa n^2(2chiD^2-kappa chiD+J1)+kappa n(J1/2-chiD^2)+J1(1-chiD)),"?"]]]; (* Conditions for applicability of Thm 1 in paper I *) fcon[x_] := If[x < 1, x + 1/2, If[x < 15/8, Sqrt[2 x + 1/4], If[x < 9/4, 2/3 x + 3/4, If[x < 3, 1/3 x + 3/2, 1/2 x + 1]]]]; Con[kappa_, mu_, M_] := (2 mu)/3 fcon[mu/kappa] + M; (* Answer from simplified version of Soheyla's Thm 1.2, for r=1 *) ChiO1[kappa_, c2_, mu_, M_, n_] := kappa/2 n (n - 1) + (n - 1) mu - M + kappa/6 + c2/12; S1[kappa_, c2_, mu_, M_, n_] := (-1)^(ChiO1[kappa,c2, mu, M, n] + 1)/ ChiO1[kappa,c2, mu, M, n] PT[mun[kappa, mu, n], mn[kappa, mu, M, n]]; (* Determination of the minimal value of the spectral flow parameter n *) nMin [kappa_, mu_, M_] := Module[{n}, n = 1; While[Con[kappa, mun[kappa, mu, n], mn[kappa, mu, M, n]] >= 0, n++]; n ]; (* limits of summation *) ULmu[kappa_, mu_, M_] := mu + (3 kappa M)/(2 mu) + kappa/2; ULm[kappa_, mu_, M_, mup_] := (mu - mup)^2/(2 kappa) + 1/2 (mu + mup) + M; LLm[kappa_, mup_] := -((mup)^2/(2 kappa)) - 1/2 mup; (* Abelian D4-D2-D0 index from Eq 4.19 in paper I *) S2[kappa_,c2_,mu_,M_,n_]:=Module[{Mun,Mn},Mun=mun[kappa,mu,n];Mn=mn[kappa,mu,M,n]; If[Mun>0,(-1)^(ChiO1[kappa,c2,mu,M,n]+1)/ChiO1[kappa,c2,mu,M,n] (PT[Mun,Mn]-Sum[Sum[(-1)^(ChiO1[kappa,c2,mu,M,n]-mup+mp+1) (ChiO1[kappa,c2,mu,M,n]-mup+mp)PT[mup,mp] J[SFmu[kappa,Mun-mup],SFM[kappa,Mun-mup,Mn-mp+mup]],{mp,Ceiling[LLm[kappa,mup]],Floor[ULm[kappa,Mun,Mn,mup]]}],{mup,1,Floor[ULmu[kappa,Mun,Mn]]}]) ]]; (* Abelian D4-D2-D0 index from Eq 4.19 & Prop 1 in paper I *) S2Lemma[kappa_,c2_,mu_,M_,n_]:=Module[{Mun,Mn},Mun=mun[kappa,mu,n];Mn=mn[kappa,mu,M,n]; If[Mun>0,(-1)^(ChiO1[kappa,c2,mu,M,n]+1)/ChiO1[kappa,c2,mu,M,n] (PT[Mun,Mn]-If[Mun==4kappa&&Mn==-2Mun,1/2 ChiO[kappa,c2,2](ChiO[kappa,c2,2]-1),0]-Sum[Sum[(-1)^(ChiO1[kappa,c2,mu,M,n]-mup+mp+1) (ChiO1[kappa,c2,mu,M,n]-mup+mp)PT[mup,mp] J[SFmu[kappa,Mun-mup],SFM[kappa,Mun-mup,Mn-mp+mup]],{mp,Ceiling[LLm[kappa,mup]],Floor[ULm[kappa,Mun,Mn,mup]]}],{mup,1,Floor[ULmu[kappa,Mun,Mn]]}]) ]]; (* PT invariant PT[mu,M] from Eq 4.12 in paper I *) SJ[kappa_, c2_, mu_, M_] := Sum[Sum[(-1)^( ChiO1[kappa,c2, mu, M,0] - mup + mp + 1) (ChiO1[kappa,c2, mu, M,0] - mup + mp) PT[mup, mp] J[ SFmu[kappa, mu - mup], SFM[kappa, mu - mup, M - mp + mup]], {mp, Ceiling[LLm[kappa, mup]], Floor[ULm[kappa, mu, M, mup]]}], {mup, 0, Floor[ULmu[kappa, mu, M]]}]; (* Conditions and spectral flow parameters for the old version of Thm 1*) Con1[kappa_, mu_, M_] := mu^2 + (8 mu^3)/kappa - 9 M^2; Con2[kappa_, mu_, M_] := mu^2/(3 kappa) + (2 mu)/3 + M; Con3[kappa_, mu_, M_] := mu^2/(2 kappa) + mu (1/2 - 1/kappa) + M + 1/kappa + 1; Con4[kappa_, mu_, M_] := mu^2/(2 kappa) + 2 mu + 3/4 kappa + 9/4 (M^2 kappa)/mu^2 + ( 3 M kappa)/mu + 5/2 M; nMinOld [kappa_, mu_, M_] := Module[{n}, n = 1; While[ Con1[kappa, mun[kappa, mu, n], mn[kappa, mu, M, n]] >= 0 || Con2[kappa, mun[kappa, mu, n], mn[kappa, mu, M, n]] >= 0 || Con3[kappa, mun[kappa, mu, n], mn[kappa, mu, M, n]] >= 0 || Con4[kappa, mun[kappa, mu, n], mn[kappa, mu, M, n]] >= 0, n++]; n ]; (* determine allowed values of (r,c) in Lemma 1 from paper I *) Rankm1WC0[{x_, alpha_}] := Module[{b1, b2, rmax, Li, r01max, xmin}, b1 = alpha - Sqrt[alpha^2 - 2 x]; b2 = alpha + Sqrt[alpha^2 - 2 x]; rmax = Floor[b1/(b2 - b1)]; r01max = Floor[b2/(b2 - b1)]; Li = Drop[ Flatten[ Table[ Table[{r, c}, {c, Ceiling[b2 r], Floor[b1 (1 + r)]}], {r, 0, rmax}], 1], 1]; If[Length[Li] < 8, Li, 999] ]; (* for each (r,c), further determine allowed (r0,r1) *) Rankm1WC[{x_, alpha_}] := Module[{b1, b2, rmax, Li, r01max, xmin}, If[alpha^2 < 2 x, Print["The BMT line does not intersect the parabola"]]; If[alpha^2 == 2 x, Print["The BMT line is tangent to parabola"]]; b1 = alpha - Sqrt[alpha^2 - 2 x]; b2 = alpha + Sqrt[alpha^2 - 2 x]; Print["(b1,b2)=", N[{b1, b2}]]; If[alpha > fcon[x], Print["Satisfies Thm 1.1"]]; rmax = Floor[b1/(b2 - b1)]; r01max = Floor[b2/(b2 - b1)]; Li = Drop[ Flatten[ Table[ Table[{r, c}, {c, Ceiling[b2 r], Floor[b1 (1 + r)]}], {r, 0, rmax}], 1], 1]; Print["Allowed (r,c):", Li]; Table[ Print["(r,c)=", Li[[i]], ": E0:", Li[[i]], ", E1:", {-1, 0} - Li[[i]]]; Do[If[ r0 + r1 >= 1 && r0 + r1 <= r01max && r1 - 1 - Li[[i, 1]] >= 0, xmin = -b2^2/2 + 1/2 (b2^2 - b1^2) (r0 + r1); Print[ "{{r0',r0},{r1',r1}=", {{Li[[i, 1]] + r0, r0}, {r1 - 1 - Li[[i, 1]], r1}}, ", x<=", N[xmin]]]; , {r0, 0, r01max}, {r1, 0, r01max}]; , {i, Length[Li]}]; ]; (* Castelnuovo bound on the D0-charge for PT invariants with r=2 *) Mr2Min[kappa_, mu_] := Ceiling[-(mu^2/(4 kappa)) - mu]; (* action of the spectral flow for r=2 *) munr2[kappa_, mu_, n_] := mu + 2n kappa; mnr2[kappa_, mu_, M_, n_] := M - n mu - kappa (n^2 + 2n); (* from (mu,M) after spectral flow with n to (x,\[Alpha]) *) mumToxar2[kappa_,{mu_, M_}, n_] := Module[{Mun, Mn}, Mun = munr2[kappa, mu, n]; Mn = mnr2[kappa, mu, M, n]; If[(-((3 Mn)/(2 Mun)))^2 > 2 (Mun/kappa), {Mun/kappa, -((3 Mn)/(2 Mun))}, {}]]; (* spectral flow transformation bringing D2 brane charge to the interval [0,\[Kappa]] for r=2 *) SFmur2[kappa_, mu_] := Module[{x = Round[mu/(2kappa)]}, If[2kappa x > mu, 2kappa x - mu , mu - 2kappa x]]; SFMr2[kappa_, mu_, M_] := Module[{x = Round[mu/(2kappa)]}, If[2kappa x > mu, M + mu x + kappa x (2 - x) - 2(2kappa x - mu),M + mu x + kappa x (2 - x)]]; (* Conditions for applicability of Thm 1 in paper II *) fcon2[x_] := If[x < 1, x + 1/2, If[x < 15/8, Sqrt[2 x + 1/4], If[x < 9/4, 2/3 x + 3/4, If[x < 3, 1/3 x + 3/2, If[x<4,1/2 x + 1,If[x<9,3/2Sqrt[x],1/3x+3/2]]]]]]; Conr2[kappa_, mu_, M_] := Module[{x,alpha}, If[mu/kappa>4,x=mu/kappa; alpha= -((3M)/(2 mu));If[x<9,alpha>3/2 Sqrt[x],alpha>x/3+3/2],False]]; (* Determination of the minimal value of the spectral flow parameter n for r=2 *) nr2Min [kappa_, mu_, M_] := Module[{n}, n = 1; While[!Conr2[kappa, munr2[kappa, mu, n], mnr2[kappa, mu, M, n]] , n++];n]; (* Contribution from P1 *) Chi1[kappa_, c2_, Q_, m_,Qp_,mp_] := m-mp+Q+Qp-(kappa/6 + c2/12); UL1Qp[kappa_,Q_,m_]:=Q+(3 kappa m)/(2 Q)+kappa/2; UL1mp[kappa_,Q_,m_,Qp_]:=(Q-Qp)^2/(2 kappa)+1/2 (Q+Qp)+m; LL1mp[kappa_,Q_,Qp_]:=1/(3 kappa) (2Qp^2-2 Q Qp+kappa Qp); P1[kappa_,c2_,Q_,m_]:=Sum[Sum[(-1)^Chi1[kappa,c2, Q, m,Qp,mp] Chi1[kappa,c2, Q, m,Qp,mp]PTw[kappa,c2,Qp,mp,(2Q-3Qp)/kappa-1] J[SFmu[kappa,Q-Qp],SFM[kappa,Q-Qp,m-mp+Qp]],{mp,Ceiling[LL1mp[kappa,Q,Qp]],Floor[UL1mp[kappa,Q,m,Qp]]}],{Qp,0,Floor[UL1Qp[kappa,Q,m]]}]; (* Evaluation of PT^w *) PTw[kappa_,c2_,Q_,m_,w_]:=PT[Q,m]-Sum[Sum[(-1)^Chi1[kappa,c2, Q, m,Qp,mp] Chi1[kappa,c2, Q, m,Qp,mp]PT[Qp,mp] J[SFmu[kappa,Q-Qp],SFM[kappa,Q-Qp,m-mp+Qp]],{mp,Ceiling[-(Qp^2/(2 kappa)+Qp/2)],Floor[UL1mp[kappa,Q,m,Qp]]}],{Qp,0,Floor[kappa/2 (1-w)+Q/2-0.00001]}]; (* Contribution from P2 *) UL2sumMmp[kappa_,Q_,m_,mup_]:=m+2Q+mup^2/(2 kappa)-11/2 mup+5 kappa; UL2sumMp[kappa_,Q_,m_,mup_]:=m+(Q-2mup)^2/(2 kappa)+11/2 Q-13mup+11 kappa; LL2Mp[kappa_,mup_]:=-((mup)^2/(2 kappa))-mup/2; (* LL2mp[kappa_,Q_,mup_]:=-(1/3)((2(Q-2mup)^2)/kappa+13(Q-2mup)+21 kappa); *) LL2mp[kappa_,Q_,mup_]:=-(1/2)((Q-2mup)^2/kappa+7(Q-2mup)+12 kappa); Chi2[kappa_, c2_,Q_, mup_,Mp_] := -Mp-Q-mup+1/6 kappa + c2/12; P2[kappa_,c2_,Q_,m_]:=1/2 Sum[Sum[Sum[(-1)^(Chi2[kappa,c2, Q, mup,Mp]+Chi2[kappa,c2, Q, mup,Mpp]+1) Chi2[kappa,c2, Q, mup,Mp]Chi2[kappa,c2, Q, mup,Mpp]PT[Q-2mup+3kappa,m-Mp-Mpp+2Q-6mup+5kappa] J[SFmu[kappa,mup],SFM[kappa,mup,Mp]]J[SFmu[kappa,mup],SFM[kappa,mup,Mpp]],{Mpp,Ceiling[LL2Mp[kappa,mup]],Floor[UL2sumMp[kappa,Q,m,mup]]-Mp}],{Mp,Ceiling[LL2Mp[kappa,mup]],Floor[UL2sumMp[kappa,Q,m,mup]]-Ceiling[LL2Mp[kappa,mup]]}],{mup,Ceiling[kappa/2 (1-(3m)/Q)],Floor[1/2 (Q+3kappa)]}]; (* Contribution from P3' *) Chi3[kappa_, c2_, Q_, m_,Qp_,mp_] :=m -mp+ 2(Q+Qp)-(4/3 kappa + c2/6); UL3Qp[kappa_,Q_,m_]:=Q+(3 kappa m)/Q+2kappa; UL3mp[kappa_,Q_,m_,Qp_]:=(Q-Qp)^2/(4 kappa)+(Q+Qp)+m; LL3mp[kappa_,Qp_]:=-((Qp)^2/(2 kappa))-1/2 Qp; P3[kappa_,c2_,Q_,m_]:=Sum[Sum[(-1)^Chi3[kappa,c2, Q, m,Qp,mp] Chi3[kappa,c2, Q, m,Qp,mp]PT[Qp,mp] J2[SFmur2[kappa,Q-Qp],SFMr2[kappa,Q-Qp,m-mp+2Qp]],{mp,Ceiling[LL3mp[kappa,Qp]],Floor[UL3mp[kappa,Q,m,Qp]]}],{Qp,1,Floor[UL3Qp[kappa,Q,m]]}]; (* sum of all contributions *) Sr2[kappa_,c2_,mu_,M_,n_]:=Module[{Mun,Mn},Mun=munr2[kappa,mu,n];Mn=mnr2[kappa,mu,M,n];If[Mun>0,(-1)^(Mn+kappa)/(Mn+2 Mun -ChiO[kappa, c2, 2]) ( PT[Mun,Mn]- P1[kappa,c2,Mun,Mn]- P2[kappa,c2,Mun,Mn]- P3[kappa,c2,Mun,Mn])]]; (* tables of respective contributions to PT invariants; P3Tab now includes Qp=0 *) P1Tab[kappa_,c2_,Q_,m_]:=Table[(-1)^Chi1[kappa, c2,Q, m,Qp,mp] Chi1[kappa,c2, Q, m,Qp,mp]PTw[kappa,c2,Qp,mp,(2Q-3Qp)/kappa-1] J[SFmu[kappa,Q-Qp],SFM[kappa,Q-Qp,m-mp+Qp]],{Qp,0,Floor[UL1Qp[kappa,Q,m]]},{mp,Ceiling[LL1mp[kappa,Q,Qp]],Floor[UL1mp[kappa,Q,m,Qp]]}]; P2Tab[kappa_,c2_,Q_,m_]:= Table[1/2 (-1)^(Chi2[kappa, c2,Q, mup,Mp]+Chi2[kappa, Q, mup,Mpp]+1) Chi2[kappa, c2,Q, mup,Mp]Chi2[kappa, Q, mup,Mpp]PT[Q-2mup+3kappa,m-Mp-Mpp+2Q-6mup+5kappa] J[SFmu[kappa,mup],SFM[kappa,mup,Mp]]J[SFmu[kappa,mup],SFM[kappa,mup,Mpp]],{mup,Ceiling[kappa/2 (1-(3m)/Q)],Floor[1/2 (Q+3kappa)]},{Mp,Ceiling[LL2Mp[kappa,mup]],Floor[UL2sumMp[kappa,Q,m,mup]]-Ceiling[LL2Mp[kappa,mup]]},{Mpp,Ceiling[LL2Mp[kappa,mup]],Floor[UL2sumMp[kappa,Q,m,mup]]-Mp}]; P3Tab[kappa_,c2_,Q_,m_]:=Table[(-1)^Chi3[kappa, c2,Q, m,Qp,mp] Chi3[kappa,c2, Q, m,Qp,mp]PT[Qp,mp] J2[SFmur2[kappa,Q-Qp],SFMr2[kappa,Q-Qp,m-mp+2Qp]],{Qp,0,Floor[UL3Qp[kappa,Q,m]]},{mp,Ceiling[LL3mp[kappa,Qp]],Floor[UL3mp[kappa,Q,m,Qp]]}]; (* most polar terms *) M2Min[kappa_,mu_]:=Ceiling[-(mu^2/(4kappa))-mu]; CondMP[kappa_,mu_,M_]:=(M=-(mu^2/(4 kappa))-mu); bb2[kappa_,mu_,M_]:=-(mu/(2 kappa))-1+Sqrt[1-(3 mu^2)/(4 kappa^2)-(3(mu+M))/kappa]; bb1[kappa_,mu_,M_]:=-(mu/(2 kappa))-1-Sqrt[1-(3 mu^2)/(4 kappa^2)-(3(mu+M))/kappa]; UboundQ[kappa_,mu_,M_,r2_]:= (mu^2)/(2kappa)+(2+r2/2)mu+3/2 M+kappa/2 (r2^2+2 r2); Sumnn[kappa_,mu_,M_,r2_,Q_]:=M-r2 mu-2(Q-mu-2 r2 kappa)-kappa(r2^2+2 r2); Chi12[kappa_,c2_,Q1_,Q2_,n1_,n2_]:=n1+n2+2(Q1+Q2)-(4 kappa)/3-c2/6; ContribPTDT[kappa_,c2_,mu_,M_,Q_,n_,r2_]:=Module[{Qm,nm}, Qm=Q-mu-2 r2 kappa; nm=M-r2 mu-2Qm-kappa(r2^2+2 r2)-n; (-1)^Chi12[kappa,c2,Qm,Q,nm,n] Chi12[kappa,c2,Qm,Q,nm,n]PT[Qm,nm]DT[Q,n] ]; SPTDT[kappa_,c2_,mu_,M_,r2_]:=Sum[Sum[ContribPTDT[kappa,c2,mu,M,Q,n,r2],{n,MMin[kappa,Q],Floor[Sumnn[kappa,mu,M,r2,Q]]-MMin[kappa,Q-mu-2 r2 kappa]}],{Q,Max[0,Ceiling[mu+2 r2 kappa]],Floor[UboundQ[kappa,mu,M,r2]]}]; (* definition of modular functions *) E2[q_,NMax_:100] := 1 - 24 Sum[n q^n/(1 - q^n), {n, NMax}]; E4[q_,NMax_:100] := 1 + 240 Sum[n^3 q^n/(1 - q^n), {n, NMax}]; E6[q_,NMax_:100] := 1 - 504 Sum[n^5 q^n/(1 - q^n), {n, NMax}]; eta[q_,NMax_:100] := q^(1/24)*(1 + Sum[(-1)^n (q^(n (3 n - 1)/2) + q^(n (3 n + 1)/2)), {n, 1, NMax}]); MacMahon[q_,NMax_:100]:=Product[1/(1-q^k)^k,{k,NMax}]; Th[r_, kappa_, mu_, q_,NMax_:100] := Sum[(-1)^(kappa r^2 n) 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_,NMax_:100] := Sum[(kappa n/I) (-1)^(kappa r^2 n) q^(kappa r n^2/2), {n, -NMax - 1 + r/2 + mu/(kappa r), NMax + r/2 + mu/(kappa r)}]; (* exponent Delta_mu *) Deltamu[kappa_, c2_, p_, mu_] := (kappa*p^3 + c2*p)/ 24 - ((mu^2/(kappa*p) + mu*p)/2 - Floor[(mu^2/(kappa*p) + mu*p)/2]); (* number of polar terms *) PolarP[kappa_, c2_, p_] := Sum[Ceiling[Deltamu[kappa, c2, p, mu]], {mu, 0, Ceiling[(kappa*p - 1)/2]}]; (* dimension of space of VV modular forms *) Dimh[kappa_, c2_, p_] := Plus @@ {Sum[ Deltamu[kappa, c2, p, mu], {mu, 0, Ceiling[(kappa*p - 1)/2]}] + 7/24*Ceiling[(kappa*p + 1)/2], -1/ 4*(-1)^(1/6 kappa*p^3 + c2*p/12)*(KroneckerDelta[0, Mod[kappa*p, 4]] + KroneckerDelta[1, Mod[kappa*p, 4]]), 1/3*(KroneckerDelta[2, Mod[kappa*p, 6]] + KroneckerDelta[3, Mod[kappa*p, 6]])}; ZPolarNaive[kappa_, c2_, r_, Ord_] := Module[{L}, L = kappa r^3/6 + c2 r/12; Normal[Table[Series[Sum[ If[(L - n - r mu) > 0, (-1)^(n + r mu + L + 1) (L - n - r mu) DT[mu, n] q^(-(kappa r^3 + c2 r)/24 + n + mu^2/(2 kappa r) + mu r /2), 0], {n, -DTTab[[mu + 1, 1]], (kappa r^3 + c2 r)/24 - mu^2/(2 kappa r) - mu r /2 + Ord[[mu + 1]]}], {q, 0, Ord[[mu + 1]] + If[ IntegerQ[-(kappa r^3 + c2 r)/24 + mu^2/(2 kappa r) + mu r /2], -1, 0]}], {mu, 0, Length[Ord] - 1}]]]; ZPolarNaive[kappa_, c2_, r_] := ZPolarNaive[kappa, c2, r, Table[0, {mu, 0, r kappa/2}]]; ZPolarNaiveInt[kappa_,c2_,r_,Ord_]:=Module[{L},L=kappa r^3/6+c2 r/12;Normal[Table[q^((kappa r^3+c2 r)/24-mu^2/(2kappa r)-mu r /2)Series[Sum[ If[(L-n-r mu)>0,(-1)^(n+r mu+L+1)(L-n- r mu)DT[mu,n]q^(-(kappa r^3+c2 r)/24+n+mu^2/(2kappa r)+mu r /2),0],{n,-DTTab[[mu+1,1]],(kappa r^3+c2 r)/24-mu^2/(2kappa r)-mu r /2+Ord[[mu+1]]}],{q,0,Ord[[mu+1]]+If[IntegerQ[-(kappa r^3+c2 r)/24+mu^2/(2kappa r)+mu r /2],-1,0]}],{mu,0,Length[Ord]-1}]]]; ZPolarNaive[kappa_,c2_,r_]:=ZPolarNaive[kappa,c2,r,Table[0,{mu,0,r kappa/2}]]; (* rules for substitution of 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]]]}; repPT = {PT[mu_, n_] :> If[n < MMin[kappa, mu], 0, If[mu + 1 <= Length[PTTab], If[n - MMin[kappa, mu] + 2 <= Length[PTTab[[mu + 1]]], PTTab[[mu + 1, n - MMin[kappa, mu] + 2]], PT[mu, n]], PT[mu, n]]]}; repPTGv = {PT[mu_, n_] :> If[n < MMin[kappa, mu], 0, If[mu + 1 <= Length[PTTabGv], If[n - MMin[kappa, mu] + 2 <= Length[PTTabGv[[mu + 1]]], PTTabGv[[mu + 1, n - MMin[kappa, mu] + 2]], PT[mu, n]], PT[mu, n]]]}; repDT = {DT[mu_, n_] :> If[n < MMin[kappa, mu], 0, If[mu + 1 <= Length[DTTab], If[n - MMin[kappa, mu] + 2 <= Length[DTTab[[mu + 1]]], DTTab[[mu + 1, n - MMin[kappa, mu] + 2]], DT[mu, n]], DT[mu, n]]]}; (* valid only for m close to Castelnuovo bound *) repPTApprox = {PT[b_, m_] :> Sum[ Binomial[2 g - 2, g - 1 - m] Gv[g, b], {g, 1, Floor[b^2/(2 kappa) + b/2 + 1]}] /. repGV}; (* same but do not evaluate GV invariants *) repPTApprox0 = {PT[b_, m_] :> Sum[Binomial[2 g - 2, g - 1 - m] Gv[g, b], {g, 1, Floor[b^2/(2 kappa) + b/2 + 1]}]}; repGVExt={Gv[g_,m_]:>If[g>gMax[kappa,m]||m==0||g<0,0,If[g+1<=Length[GVTabExt], If[m<=Length[GVTabExt[[g+1]]],GVTabExt[[g+1,m]],Gv[g,m]],Gv[g,m]]]}; repPTExt={PT[mu_,n_]:>If[n If[n < MMin[kappa, mu], 0, If[mu + 1 <= Length[JTab] && n + 1 <= Length[JTab[[mu + 1]]] + MMin[kappa, mu], JTab[[mu + 1, n - MMin[kappa, mu] + 1]], J[mu, n]]]}; (* evaluate PT invariants using Thm 1 in paper I *) repPTfromJ = {PT[mu_, n_] :> If[n < MMin[kappa, mu], 0, If[mu + 1 <= Length[PTTab] && n - MMin[kappa, mu] + 2 <= Length[PTTab[[mu + 1]]], PTTab[[mu + 1, n - MMin[kappa, mu] + 2]], If[Con[kappa, mu, n] < 0 , SJ[kappa,c2, mu, n], PT[mu, n]]]]}; (* evaluate rabnk 2 D4-D2-D0 using Thm 1 in paper II *) repJ2={J2[mu_,M_]:>If[M