Valence independent solutions to string equations

Several Sections of Definitions

This notebook solves string equations of all valences simultaneously.  A valence is chosen in the section “functions for making series expansions” for comparison of map counts.

Misc. definitions

P[x_,y_]:=Product[x-i,{i,0,y-1}]

T[μ_]:=Multinomial[ν-μ,2μ+1,ν-μ]

“Table product”

tProduct[L_]:=Exp[Total[Map[Log,L]]]

“Cartesian product”

cProduct[L1_,L2_]:=Flatten[Table[{L1[[i]],L2[[j]]},{i,1,Length[L1]},{j,1,Length[L2]}],1]

cProduct[{1,2},{2,5}]

intFuncs[args_,total_]:=Flatten[Map[Permutations,Map[PadRight[#,args]&,IntegerPartitions[total,args]]],1]

intFuncs[3,4]

DerivSub[X_]:=X/.(Subscript[x_, g_,m_])->Derivative[m,0,0][x][w,g,0]
IndexSub[X_]:=X/.Derivative[a_,0,0][x_][w,g_,m_]->(Subscript[x, g,a+m])/.x_[w,g_,m_]->(Subscript[x, g,m])
wDiff[X_,a_]:=IndexSub[D[DerivSub[X],{w,a}]]

wInt[X_]:=wInt2[Integrate[X/.(Subscript[f, 0,m_])->D[f[w],{w,m}]/.(Subscript[h, 0,m_])->D[h[w],{w,m}],w]]
wInt2[X_]:=Together[X/.Derivative[m_][f_][w]->(Subscript[f, 0,m])/.f[w]->(Subscript[f, 0,0])/.Derivative[m_][h_][w]->(Subscript[h, 0,m])/.h[w]->(Subscript[h, 0,0])]

wInt[X_,n_]:=Nest[wInt,X,n]

String Coefficients

If Mathematica is evaluating Q[something] it means we are building the differential operator corresponding to two partitions.
The list L tells Q what to do next, and its instructions are discarded one by one.  For example, L={(Subscript[f, 5]),(Subscript[h, 2])} means: build the operator corresponding to the first “special step” being a down step, and recieving 5 w-derivatives; and the second “special step” being a flat step, and recieving 2 w-derivatives.
Variable X stores the partially built operator.  
Variable n stores number of factors already computed.
Variable m stores how many of these were from down steps.
Here (but not in other sections) (Subscript[f, r]) represents the asymptotic expansion f differentiated r times wrt w.

Q[{},m_,n_,X_]:=X
Q[L_,m_,n_,X_]:=Q[L[[1]],L[[2;;]],m,n,X]
Q[(Subscript[f, r_]),L_,m_,n_,X_]:=Q[L,m+1,n+1,G[m,n,r,X]]
Q[(Subscript[h, r_]),L_,m_,n_,X_]:=Q[L,m,n+1,G[m,n,r,X]]

The function G builds the part of a differential operator corresponding to one part of a partition.
Variable r is the exponent corresponding to the part.

G[m_,n_,0,X_]:=X
G[m_,n_,r_,X_]:=G[m,n,r-1,-m*X+Total[Table[(Subscript[op, i])[X],{i,1,n+1}]]]

The head (Subscript[op, i]) corresponds to the operator (Subscript[z, i])(Subscript[D, (Subscript[z, i])])-(Subscript[x, i])(Subscript[D, (Subscript[x, i])]). 
We make (Subscript[op, i]) linear.

(Subscript[op, i_])[c_*X_]:=c*(Subscript[op, i])[X]/;Head[c]==Integer
(Subscript[op, i_])[X_+Y_]:=(Subscript[op, i])[X]+(Subscript[op, i])[Y]
(Subscript[op, i_])[Ready[X_]]:=Ready[(Subscript[z, i])D[X,(Subscript[z, i])]-(Subscript[x, i])D[X,(Subscript[x, i])]]

This is the ``main block’’ for calculating diagonal string equation coefficients.  
First, all ways of applying w-derivatives to special steps, that are compatible with the partitions L1 and L2 are constructed as LL. 
By plugging each instruction stored in LL into Q we end up with differential operators applied to an abstract variable A.
We replace A with what the differential operators should act on.  The “nonsense head” Ready deliberately interferes with Mathematica’s evaluation procedure.
We remove subscripts from dummy variables.
We throw away denominators because they duck with CoefficientList.  (The degree of the denominator is determined by the total degree of the numerator, so this info can be recovered.)
We extract the appropriate coefficient using a formula.  The result must be multiplied by t*T[μ] to get an actual coefficient appearing in the string equation.

DiagStringCoeff[L1_,L2_]:=((Dtep1[Permutations[Map[(Subscript[f, #])&,L1]~Join~Map[(Subscript[h, #])&,L2]],Length[L1],Length[L2],Total[L1]+Total[L2]])/(tProduct[Map[Factorial,L1~Join~L2]]))
Dtep1[LL_,N1_,N2_,S_]:=Dtep2[Total[Map[Q[#,0,0,A]&,LL]],N1,N2,S]
Dtep2[X_,N1_,N2_,S_]:=Dtep3[X/.A->Ready[Product[(1/(1-(Subscript[x, i])-(Subscript[y, i])-(Subscript[z, i]))),{i,1,N1+N2+1}]],N1,N2,S]
Dtep3[X_,N1_,N2_,S_]:=Dtep4[Expand[X/.Ready[Y_]->Y/.(Subscript[x, i_])->x/.(Subscript[y, i_])->y/.(Subscript[z, i_])->z],N1,N2,S]
Dtep4[X_,N1_,N2_,S_]:=Dtep5[CoefficientList[X/. 1-x-y-z->1,{x,z}],N1,N2,S]
Dtep5[X_,N1_,N2_,S_]:=Simplify[Total[Total[X*Table[((P[ν-μ,N1+i]P[2μ+1,N2]P[ν-μ-1,j])/((N1+N2+i+j)!)),{i,0,S},{j,0,S}]]]]

This is the ``main block’’ for calculating subdiagonal string equation coefficients.

SubStringCoeff[L1_,L2_]:=((Step1[Permutations[Map[(Subscript[f, #])&,L1]~Join~Map[(Subscript[h, #])&,L2]],Length[L1],Length[L2],Total[L1]+Total[L2]])/(tProduct[Map[Factorial,L1~Join~L2]]))
Step1[LL_,N1_,N2_,S_]:=Step2[Total[Map[Q[#,0,0,A]&,LL]],N1,N2,S]
Step2[X_,N1_,N2_,S_]:=Step3[X/.A->Ready[Product[(1/(1-(Subscript[x, i])-(Subscript[y, i])-(Subscript[z, i]))),{i,1,N1+N2+1}]],N1,N2,S]
Step3[X_,N1_,N2_,S_]:=Step4[Expand[X/.Ready[Y_]->Y/.(Subscript[x, i_])->x/.(Subscript[y, i_])->y/.(Subscript[z, i_])->z],N1,N2,S]
Step4[X_,N1_,N2_,S_]:=Step5[CoefficientList[X/. 1-x-y-z->1,{x,z}],N1,N2,S]
Step5[X_,N1_,N2_,S_]:=Simplify[Total[Total[X*Table[((P[ν-μ,N1+i]P[2μ,N2]P[ν-μ,j])/((N1+N2+i+j)!)),{i,0,S},{j,0,S}]]]]

DiagStringCoeff[{},{4}]

Out[27]/.ν->3/.μ->0

Expand[DiagStringCoeff[{3},{3,1}]]

DiagStringCoeff[{2},{}]

myChangeBasis[DiagStringCoeff[{2},{}]]

myChangeBasis[DiagStringCoeff[{4},{}]]

Simplify[((DiagStringCoeff[{4},{}])/((ν-μ)(ν-μ-1)))]

Expand[(1/60)P[ν-μ,3]+(5/360)P[ν-μ,2]]
Expand[DiagStringCoeff[{4},{}]]

myChangeBasis[DiagStringCoeff[{6},{}]]

Simplify[((DiagStringCoeff[{6},{}])/((ν-μ)(ν-μ-1)(ν-μ-2)))]

DiagStringCoeff[{3},{}]

Simplify[DiagStringCoeff[{4},{}]]

DiagStringCoeff[{5},{}]

Change of basis functions

size=10;

list1=Table[If[Mod[a,2]==0,((P[ν-μ,a/2])^2),P[ν-μ,((a+1)/2)]P[ν-μ,((a-1)/2)]],{a,0,size-1}];
list2=Table[P[2μ+1,a],{a,0,size-1}];

table1=Table[list1[[i]]list2[[j]],{i,1,size},{j,1,size}];

MatrixForm[table1[[1;;4,1;;4]]]

table2=Table[(n^i)(m^j),{i,0,size-1},{j,0,size-1}];

MatrixForm[table2[[1;;4]]]

Unprotect[CoefficientList];
CoefficientList[0,{X_,Y_}]:={{}}
Protect[CoefficientList];

myCoeffVector[X_]:=Flatten[PadRight[CoefficientList[X,{ν,μ}],{size,size}]]

myCoeffVector[table1[[2,1]]]

cbMatrix=Transpose[PadRight[Flatten[Table[myCoeffVector[table1[[i,j]]],{i,1,size},{j,1,size}],1]]];

MatrixForm[cbMatrix[[1;;16,1;;16]]]

myChangeBasis[X_]:=Total[LinearSolve[cbMatrix,myCoeffVector[X]]*Flatten[table1]]

myChangeBasis2[X_]:=Total[LinearSolve[cbMatrix,myCoeffVector[X]]*Flatten[table2]]

myChangeBasis[(μ^4)(ν^2)]

Expand[%]

Construct str eq monomials

gtf[p_,L_]:=tProduct[Map[(((Subscript[f, #1,#2]))&@@#)&,Partition[Riffle[L,p],2]]]
gth[p_,L_]:=tProduct[Map[(((Subscript[h, #1,#2]))&@@#)&,Partition[Riffle[L,p],2]]]

fRest[g_,l_]:=Total[Map[fRest2[#,l]&,IntegerPartitions[g]]]
fRest2[p_,l_]:=Multinomial@@(Map[Length,Gather[p]]~Join~{ν-μ-l-Length[p]})*tProduct[Map[(Subscript[f, #,0])&,p]]*((Subscript[f, 0,0])^(ν-μ-l-Length[p]))

hRest[isDiag_,g_,l_]:=Total[Map[hRest2[isDiag,#,l]&,IntegerPartitions[g]]]
hRest2[isDiag_,p_,l_]:=Multinomial@@(Map[Length,Gather[p]]~Join~{2μ+isDiag-l-Length[p]})*tProduct[Map[(Subscript[h, #,0])&,p]]*((Subscript[h, 0,0])^(2μ+isDiag-l-Length[p]))

getTerm[isDiag_,p1_,p2_,g1_,g2_,L1_,L2_]:=gtf[p1,L1]*gth[p2,L2]*fRest[g1,Length[p1]]*hRest[isDiag,g2,Length[p2]]

specialListPartition[l1_,l2_]:={l1[[1]],l2[[1]],l1[[2;;]],l2[[2;;]]}

partsToTerm[p1_,p2_,level_,isDiag_]:=ptt1[p1,p2,level-Total[p1~Join~p2],isDiag]
ptt1[p1_,p2_,excess_,isDiag_]:=ptt2[p1,p2,Flatten[Table[cProduct[intFuncs[Length[p1]+1,r/2],intFuncs[Length[p2]+1,excess-r]],{r,0,excess}],1],isDiag]

ptt2[p1_,p2_,L_,isDiag_]:=Total[Map[getTerm@@({isDiag,p1,p2}~Join~#)&,Map[(specialListPartition[#1,#2]&)@@#&,L]]]

partsToTerm[{3},{},4,1]

partsToTerm[{3},{},4,1]

Construct string equations

partlist[n_]:=partlist[n-1]~Join~Flatten[Table[cProduct[IntegerPartitions[i],IntegerPartitions[n-i]],{i,0,n}],1]
partlist[0]={{{},{}}};

MatrixForm[partlist[2]]

StrD[n_]:=Total[Table[myChangeBasis[(partsToTerm[#1,#2,n,1]&)@@#&[partlist[n][[i]]]*(ν-μ)DiagStringCoeff@@partlist[n][[i]]],{i,1,Length[partlist[n]]}]]
StrS[n_]:=Total[Table[myChangeBasis[(partsToTerm[#1,#2,n,0]&)@@#&[partlist[n][[i]]]*(2μ+1)SubStringCoeff@@partlist[n][[i]]],{i,1,Length[partlist[n]]}]]

AltStrD[n_]:=Total[Table[myChangeBasis2[(partsToTerm[#1,#2,n,1]&)@@#&[partlist[n][[i]]]*(ν-μ)DiagStringCoeff@@partlist[n][[i]]],{i,1,Length[partlist[n]]}]]
AltStrS[n_]:=Total[Table[myChangeBasis2[(partsToTerm[#1,#2,n,0]&)@@#&[partlist[n][[i]]]*(2μ+1)SubStringCoeff@@partlist[n][[i]]],{i,1,Length[partlist[n]]}]]

D2=AltStrD[2]

S2=AltStrS[2]

D4=AltStrD[4];

S4=AltStrS[4];

Build bait and bolt

Q=((((Subscript[f, 0,1])))^2)-(Subscript[f, 0,0])((((Subscript[h, 0,1])))^2);
allMu[1]=1-((Subscript[f, 0,1])/Q);
oneNu[1]=(((Subscript[f, 0,0])(Subscript[h, 0,1]))/Q);
allMu[n_]:=Together[-(((Subscript[f, 0,0])(Subscript[h, 0,1]))/Q)wDiff[allMu[n-1],1]+((Subscript[f, 0,1])/Q)wDiff[oneNu[n-1],1]]
oneNu[n_]:=Together[(((Subscript[f, 0,0])(Subscript[f, 0,1]))/Q)wDiff[allMu[n-1],1]-(((Subscript[f, 0,0])(Subscript[h, 0,1]))/Q)wDiff[oneNu[n-1],1]]

size=8;

bait=Table[If[Mod[r,2]==0,((Subscript[h, 0,0])^(2μ+1-c))((Subscript[f, 0,0])^(ν-μ-r/2)),((Subscript[h, 0,0])^(2μ+1-c))((Subscript[f, 0,0])^(ν-μ-(r-1)/2))],{r,0,8},{c,0,6}];

MatrixForm[bait[[1;;4,1;;4]]]

bolt=Table[If[8≥r+c≥2,If[Mod[r,2]==0,allMu[r+c-1],oneNu[r+c-1]],0],{r,0,8},{c,0,6}];

MatrixForm[bolt[[1;;3,1;;3]]]

Functions for making series expansions

SeriesLength=20;
valence=7;

ZList=Import["Desktop/gMapData/zTables/z0Valence"~StringJoin~ToString[valence]~StringJoin~"CSV","CSV"][[1,1;;SeriesLength]];
UList=Import["Desktop/gMapData/uTables/u0Valence"~StringJoin~ToString[valence]~StringJoin~"CSV","CSV"][[1,1;;SeriesLength]];

(Subscript[z, 0])[t_]:=Sum[ZList[[i]]*((t^(i-1))/((i-1)!)),{i,1,Length[ZList]}]
(Subscript[u, 0])[t_]:=Sum[UList[[i]]*((t^(i-1))/((i-1)!)),{i,1,Length[UList]}]

MakeSeries[X_]:=Series[X/.(Subscript[f, 0,m_])->Derivative[m][Function[w2,w2*(Subscript[z, 0])[(w2^(valence/2-1))*t]]][1]/.(Subscript[h, 0,m_])->Derivative[m][Function[w2,(w2^(1/2))*(Subscript[u, 0])[(w2^(valence/2-1))*t]]][1],{t,0,SeriesLength}]

derivs[X_]:=PadRight[CoefficientList[MakeSeries[X],t],SeriesLength+1]*Table[a!,{a,0,SeriesLength}]

derivs[(Subscript[f, 0,0])]

bolt[[3,6]]

MakeSeries[bolt[[3,6]]]

MakeSeries[t*Total[Table[T[μ]P[2μ+1,5]P[ν-μ,1]P[ν-μ,1]bait[[3,6]],{μ,0,3}]]/.ν->((valence-1)/2)]

Functions for (Subscript[f, g]) and (Subscript[h, g]) substitutions

(Subscript[h, g_,m_])/;Mod[g,2]==1:=-Total[Table[((BernoulliB[k](Subscript[h, g-k,m+k]))/(k!)),{k,1,g}]]

(Subscript[h, 3,0])

Note: FSubTable and HSubTable must be ``updated’’ each time new (Subscript[f, g]) and (Subscript[h, 2g]) are computed.  To do this paste the following command appropriately.  The alternative of defining FSubTable and HSubTable with	   :=	is prohibitively slow.

FSubTable=Table[(Subscript[f, g1,m1])->Together[wDiff[(Subscript[F, g1]),m1]],{g1,1,1},{m1,0,5}];
HSubTable=Table[(Subscript[h, g1,m1])->Together[wDiff[(Subscript[H, g1]),m1]],{g1,2,2,2},{m1,0,5}];

MatrixForm[FSubTable]

makeSubs[X_,l_]:=Together[Fold[ReplaceAll,X,Flatten[FSubTable[[1;;l/2]]~Join~HSubTable[[1;;l/2]]]]]

Solve String Eqs

Solve String2

tableToExpr[X_]:=Total[Total[X*table1[[1;;Length[X],1;;Length[X[[1]]]]]]]

Str2fMatrix=CoefficientList[(Subscript[f, 0,1])*D2+(Subscript[f, 0,0])(Subscript[h, 0,1])*S2,{n,m}];

Str2fMatrix[[3,1]]=Str2fMatrix[[3,1]]-(Subscript[f, 0,0]^(-1-μ+ν)) (Subscript[f, 0,1]) (Subscript[f, 1,0]) (Subscript[h, 0,0]^(1+2 μ));
Str2fMatrix[[2,2]]=Str2fMatrix[[2,2]]-((Subscript[f, 0,0]^(-μ+ν)) (Subscript[f, 1,0]) (Subscript[h, 0,0]^(2 μ)) (Subscript[h, 0,1])+(Subscript[f, 0,0]^(-μ+ν)) (Subscript[f, 0,1]) (Subscript[h, 0,0]^(2 μ)) (Subscript[h, 2,0]));
Str2fMatrix[[1,3]]=Str2fMatrix[[1,3]]-(Subscript[f, 0,0]^(1-μ+ν)) (Subscript[h, 0,0]^(-1+2 μ)) (Subscript[h, 0,1]) (Subscript[h, 2,0]);

Str2hMatrix=CoefficientList[(Subscript[f, 0,1])*S2+(Subscript[h, 0,1])*D2,{n,m}];

Str2hMatrix[[3,1]]=Str2hMatrix[[3,1]]-(Subscript[f, 0,0]^(-1-μ+ν)) (Subscript[f, 1,0]) (Subscript[h, 0,0]^(1+2 μ)) (Subscript[h, 0,1]);
Str2hMatrix[[2,2]]=Str2hMatrix[[2,2]]-((Subscript[f, 0,0]^(-1-μ+ν)) (Subscript[f, 0,1]) (Subscript[f, 1,0]) (Subscript[h, 0,0]^(2 μ))+(Subscript[f, 0,0]^(-μ+ν)) (Subscript[h, 0,0]^(2 μ)) (Subscript[h, 0,1]) (Subscript[h, 2,0]));
Str2hMatrix[[1,3]]=Str2hMatrix[[1,3]]-(Subscript[f, 0,0]^(-μ+ν)) (Subscript[f, 0,1]) (Subscript[h, 0,0]^(-1+2 μ)) (Subscript[h, 2,0]);

MatrixForm[Str2hMatrix]

MatrixForm[Str2fMatrix]

tableToExpr[Str2fMatrix];

(Subscript[H, 2])=Together[Total[Total[Table[If[Str2hMatrix[[r,c]]===0,0,Str2hMatrix[[r,c]]/bait[[r,c]]*bolt[[r,c]]],{r,1,5},{c,1,4}]]]]

(Subscript[F, 1])=Together[Total[Total[Table[If[Str2fMatrix[[r,c]]===0,0,Str2fMatrix[[r,c]]/bait[[r,c]]*bolt[[r,c]]],{r,1,5},{c,1,4}]]]]

(Subscript[λ, 0])=Log[(Subscript[f, 0,0])];
(Subscript[λ, 1])=((Subscript[F, 1])/(Subscript[f, 0,0]));

(Subscript[e, 1])=wInt[(Subscript[λ, 1]),2]+Zeta[-1](Subscript[λ, 0])

derivs[(Subscript[F, 1])]

derivs[(Subscript[H, 2])]

The zero-vertex map count for (Subscript[e, 1]) comes out crazy, but the rest are correct.

derivs[(Subscript[e, 1])]

(Subscript[H, 3])=Together[(1/2)wDiff[(Subscript[H, 2]),1]-(1/24)wDiff[(Subscript[h, 0,0]),3]]

derivs[(Subscript[H, 3])]

wInt[(Subscript[H, 2])]

wInt[(Subscript[H, 3])]

Solve String4

Str4fMatrix=CoefficientList[(Subscript[f, 0,1])*D4+(Subscript[f, 0,0])(Subscript[h, 0,1])*S4,{n,m}];
Str4hMatrix=CoefficientList[(Subscript[h, 0,1])*D4+(Subscript[f, 0,1])*S4,{n,m}];

Dimensions[Str4fMatrix]

Str4fMatrix[[3,1]]=Str4fMatrix[[3,1]]-(Subscript[f, 0,0]^(-1-μ+ν)) (Subscript[f, 0,1]) (Subscript[f, 2,0]) (Subscript[h, 0,0]^(1+2 μ));
Str4fMatrix[[2,2]]=Str4fMatrix[[2,2]]-((Subscript[f, 0,0]^(-μ+ν)) (Subscript[f, 2,0]) (Subscript[h, 0,0]^(2 μ)) (Subscript[h, 0,1])+(Subscript[f, 0,0]^(-μ+ν)) (Subscript[f, 0,1]) (Subscript[h, 0,0]^(2 μ)) (Subscript[h, 4,0]));
Str4fMatrix[[1,3]]=Str4fMatrix[[1,3]]-(Subscript[f, 0,0]^(1-μ+ν)) (Subscript[h, 0,0]^(-1+2 μ)) (Subscript[h, 0,1]) (Subscript[h, 4,0]);

Str4hMatrix[[3,1]]=Str4hMatrix[[3,1]]-(Subscript[f, 0,0]^(-1-μ+ν)) (Subscript[f, 2,0]) (Subscript[h, 0,0]^(1+2 μ)) (Subscript[h, 0,1]);
Str4hMatrix[[2,2]]=Str4hMatrix[[2,2]]-((Subscript[f, 0,0]^(-1-μ+ν)) (Subscript[f, 0,1]) (Subscript[f, 2,0]) (Subscript[h, 0,0]^(2 μ))+(Subscript[f, 0,0]^(-μ+ν)) (Subscript[h, 0,0]^(2 μ)) (Subscript[h, 0,1]) (Subscript[h, 4,0]));
Str4hMatrix[[1,3]]=Str4hMatrix[[1,3]]-(Subscript[f, 0,0]^(-μ+ν)) (Subscript[f, 0,1]) (Subscript[h, 0,0]^(-1+2 μ)) (Subscript[h, 4,0]);

FSubTable=Table[(Subscript[f, g1,m1])->Together[wDiff[(Subscript[F, g1]),m1]],{g1,1,1},{m1,0,5}];
HSubTable=Table[(Subscript[h, g1,m1])->Together[wDiff[(Subscript[H, g1]),m1]],{g1,2,2,2},{m1,0,5}];

Str4fMatrix=Map[makeSubs[#,2]&,Str4fMatrix,{2}];
Str4hMatrix=Map[makeSubs[#,2]&,Str4hMatrix,{2}];

derivs[t*Total[Table[T[μ]*tableToExpr[Str4fMatrix],{μ,0,3}]]/.ν->3]

(Subscript[H, 4])=Together[Total[Total[Table[If[Str4hMatrix[[r,c]]===0,0,Str4hMatrix[[r,c]]/bait[[r,c]]*bolt[[r,c]]],{r,1,8},{c,1,6}]]]]

(Subscript[F, 2])=Together[Total[Total[Table[If[Str4fMatrix[[r,c]]===0,0,Str4fMatrix[[r,c]]/bait[[r,c]]*bolt[[r,c]]],{r,1,8},{c,1,6}]]]]

(Subscript[λ, 2])=((Subscript[F, 2])/(Subscript[f, 0,0]))-(1/2)(((((Subscript[F, 1])/(Subscript[f, 0,0]))))^2);

(Subscript[e, 2])=wInt[(Subscript[λ, 2]),2]+Zeta[-1](Subscript[λ, 1])+((Zeta[-3])/2)wDiff[(Subscript[λ, 0]),2]

derivs[(Subscript[H, 4])]

derivs[(Subscript[F, 2])]

The zero-vertex map count for (Subscript[e, 2]) comes out crazy, but the rest are correct.

derivs[(Subscript[e, 2])]

wInt[(Subscript[H, 4])]