2
$\begingroup$

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!

Improve this question
$\endgroup$
2

2 Answers 2

Reset to default
2
$\begingroup$

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

Improve this answer
$\endgroup$
2
  • $\begingroup$ I'm puzzled why this is different from my result in the higher order terms. ( up to order 3 the same.. ) $\endgroup$ Commented Apr 26, 2018 at 13:10
  • $\begingroup$ @george2079 I used AgenusTotal[5] instead of AgenusTotal[3] $\endgroup$ Commented Apr 26, 2018 at 13:49
1
$\begingroup$

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

[![enter image description here][1]][1]...

 Simplify[Total[result] == series]

True

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.