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!

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

$\endgroup$
  • $\begingroup$ I'm puzzled why this is different from my result in the higher order terms. ( up to order 3 the same.. ) $\endgroup$ – george2079 Apr 26 '18 at 13:10
  • $\begingroup$ @george2079 I used AgenusTotal[5] instead of AgenusTotal[3] $\endgroup$ – Carl Woll Apr 26 '18 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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.