# Grouping terms in Taylor expansion

I have this code:

genus[Q_, n_Integer] :=
Module[{z, x},
SymmetricReduction[
SeriesCoefficient[
Product[ComposeSeries[Series[Q[z], {z, 0, n}],
Series[x[i] z, {z, 0, n}]], {i, 1, n}], n],
Table[x[i], {i, 1, n}], Table[Subscript[c, i], {i, 1, n}]][[
1]] // FactorTerms];
AgenusTotal[n_Integer] :=
Total[Table[
genus[(Sqrt[#]/2)/Sinh[Sqrt[#]/2] &, i] /. c -> p, {i, 0, n}]];


Which generates certain polynomials. For example, for n=3 I get:

$-\frac{p_1}{24}+\frac{7 p_1^2-4 p_2}{5760}+\frac{-31 p_1^3+44 p_2 p_1-16 p_3}{967680}+1$

I need to take the square root of this expression (as a Taylor expansion) and group together terms of similar order (here by order I mean $p_1^3$, $p_1p_2$ and $p_3$ are, for example, of order 3 (each $p_i$ is a polynomial of degree i of another variable), the same way they are grouped in the expression itself. I have this code now:

Series[Series[
Series[Sqrt[AgenusTotal[3]], {Subscript[p, 1], 0, 5}], {Subscript[p,
2], 0, 5}], {Subscript[p, 3], 0, 5}]
SeriesCoefficient[
SeriesCoefficient[
SeriesCoefficient[
Series[Series[
Series[Sqrt[AgenusTotal[3]], {Subscript[p, 1], 0,
5}], {Subscript[p, 2], 0, 5}], {Subscript[p, 3], 0, 5}], 2],
2], 1];


It works for individual examples, but I would like something more independent and ideally without putting a lot of Series[Series[ Series[ terms or SeriesCoefficient[ SeriesCoefficient[ SeriesCoefficient[ terms by hand (which would be tedious for n large). Also I would like to pick the right terms automatically, without specifying the SeriesCoefficient by hand (as in this way I might miss certain terms). Can someone help me? Thank you!

I would use the standard trick of including an order parameter, and finding the series expansion around the parameter. For instance:

series = Series[Sqrt[AgenusTotal[5] /. Subscript[p, i_]:>t^i Subscript[p, i]], {t, 0, 5}];
series //TeXForm


$1-\frac{p_1 t}{48}+\frac{\left(9 p_1^2-8 p_2\right) t^2}{23040}+\frac{\left(-61 p_1^3+120 p_2 p_1-64 p_3\right) t^3}{7741440}+\frac{\left(1261 p_1^4-3824 p_2 p_1^2+2816 p_3 p_1+1216 p_2^2-1536 p_4\right) t^4}{7431782400}+\frac{\left(-14931 p_1^5+60784 p_2 p_1^3-50048 p_3 p_1^2-45120 p_2^2 p_1+37376 p_4 p_1+31744 p_2 p_3-20480 p_5\right) t^5}{3923981107200}+O\left(t^6\right)$

If you just want the coefficients:

CoefficientList[series, t] //TeXForm


$\left\{1,-\frac{p_1}{48},\frac{9 p_1^2-8 p_2}{23040},\frac{-61 p_1^3+120 p_2 p_1-64 p_3}{7741440},\frac{1261 p_1^4-3824 p_2 p_1^2+2816 p_3 p_1+1216 p_2^2-1536 p_4}{7431782400},\frac{-14931 p_1^5+60784 p_2 p_1^3-50048 p_3 p_1^2-45120 p_2^2 p_1+37376 p_4 p_1+31744 p_2 p_3-20480 p_5}{3923981107200}\right\}$

• I'm puzzled why this is different from my result in the higher order terms. ( up to order 3 the same.. ) – george2079 Apr 26 '18 at 13:10
• @george2079 I used AgenusTotal[5] instead of AgenusTotal[3] – Carl Woll Apr 26 '18 at 13:49

I think this does it..

vars = {Subscript[p, 1], Subscript[p, 2], Subscript[p, 3]};
series = Normal@
Series[Sqrt[AgenusTotal[3]], Sequence @@ ({#, 0, 5} & /@ vars)];
a = CoefficientList[series, vars];
result = Total[#[[All, 1]]] & /@ SortBy[
GatherBy[Flatten[MapIndexed[
{# Times @@ (vars^(#2 - 1)),
#2.Range[Length@vars] -
(Length@vars) (Length@vars + 1)/2 } &,
a, {-1}], 2], #[[2]] &], #[[1, 2]] &]

result[[;; 6]] // Simplify // TableForm


  Simplify[Total[result] == series]


True