Grouping terms in Taylor expansion

Question

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!

Answer 1

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\}$

Answer 2

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