3
$\begingroup$

Given a polynomial like $x^3 + a_2 x^2 + a_1 x + a_0$ with roots $r_i$, I would like to symbolically compute the coefficients of a polynomial whose roots are $r_i^3 + r_i + 1$. How can I do this in Mathematica?

$\endgroup$
0

4 Answers 4

9
$\begingroup$

I upvoted the other responses. That said, there is a better way.

CoefficientList[
 Resultant[x^3 + a2*x^2 + a1*x + a0, y - (x^3 + x + 1), x], y]

(* Out[1179]= {-1 + 4 a0 - 3 a0^2 + a0^3 - a1 - 2 a0 a1 + 2 a1^2 + 
  a0 a1^2 - a1^3 + a2 + a0 a2 - 2 a0^2 a2 - 3 a1 a2 + 3 a0 a1 a2 + 
  a0 a2^2 - a1 a2^2 + a2^3, 
 3 - 6 a0 + 3 a0^2 + a1 - 2 a1^2 + a1^3 - 2 a2 - a0 a2 + 6 a1 a2 - 
  3 a0 a1 a2 + a1 a2^2 - 2 a2^3, -3 + 3 a0 + a2 - 3 a1 a2 + a2^3, 1} *)
$\endgroup$
4
$\begingroup$

The direct way works:

Times @@ Table[
     x - With[{r = Root[#1^3 + a2 #1^2 + a1 #1 + a0 &, i]}, r^3 + r + 1], 
     {i, 3}] // 
      Expand // 
      Simplify // 
      CoefficientList[#, x] &

{-1 + 4 a0 - 3 a0^2 + a0^3 - a1 - 2 a0 a1 + 2 a1^2 + a0 a1^2 - a1^3 + 
  a2 + a0 a2 - 2 a0^2 a2 - 3 a1 a2 + 3 a0 a1 a2 + a0 a2^2 - a1 a2^2 + 
  a2^3, 

  3 - 6 a0 + 3 a0^2 + a1 - 2 a1^2 + a1^3 - 2 a2 - a0 a2 + 
  6 a1 a2 - 3 a0 a1 a2 + a1 a2^2 - 2 a2^3, 

  -3 + 3 a0 + a2 - 3 a1 a2 + a2^3, 

  1}
$\endgroup$
2
$\begingroup$

Another direct approach

p1 = #1^3 + a2 #1^2 + a1 #1 + a0 &;
p2 = 1 + # + #^3 &;

Simplify@CoefficientList[Product[x - p2@Root[p1, i], {i, Exponent[p1@x, x]}], x]

Mathematica graphics

Or make it a function that takes two polynomials, p1 and p2, and produces the coefficients of the polynomial p2 evaluated at the roots of p1

ClearAll[f]
f = Simplify@CoefficientList[Product[x - #2@Root[#, i], {i, Exponent[#@x, x]}],
      x] &;

Examples:

f[p1, p2]

Mathematica graphics

f[p1, 2 + #^2 &]

Mathematica graphics

$\endgroup$
2
$\begingroup$

A slick way is to use the Newton-Girard formulae in conjunction with the handy RootSum[] function:

Solve[Table[s[m] == RootSum[Function[x, x^3 + b x^2 + c x + d], 
                            Function[r, (r^3 + r + 1)^m]], {m, 3}] ~Join~
      Table[-Sum[s[k] e[m - k], {k, m - 1}] - m e[m] == s[m], {m, 3}], 
      Array[e, 3], Array[s, 3]] // Expand
   {{e[1] -> -3 + b + b^3 - 3 b c + 3 d, 
     e[2] -> 3 - 2 b - 2 b^3 + c + 6 b c + b^2 c - 2 c^2 + c^3 - 6 d - b d -
             3 b c d + 3 d^2, 
     e[3] -> -1 + b + b^3 - c - 3 b c - b^2 c + 2 c^2 - c^3 + 4 d + b d + b^2 d - 2 c d +
             3 b c d + c^2 d - 3 d^2 - 2 b d^2 + d^3}}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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