9
$\begingroup$

I'm trying to find the roots for $x^4-18x^2-8x+21$. Theoretically, one can show that it has four real roots. But the following line returns four complicated forms including complex numbers.

Is there a way to reduce the results to be in a nice form?

Solve[x^4-18x^2-8x+21==0,x]

enter image description here

$\endgroup$
  • 6
    $\begingroup$ I believe this is a case of casus irreducibilis; i.e. the real solutions cannot be expressed without using the imaginary unit. The only "nice" way would be to make Root objects. If you apply N to the result (and Chop them), you will get a real number. $\endgroup$ – JungHwan Min Nov 18 '16 at 0:37
  • 2
    $\begingroup$ You can apply N[] to the solutions to get a numerical approximation and you'll see that, as you said, they're essentially real numbers (the imaginary parts are many orders of magnitude smaller than the real parts). Not sure how to get an exact real solution, though. $\endgroup$ – Cassini Nov 18 '16 at 0:37
  • $\begingroup$ What a nice form is depends on what you want to do with the results. Do you just want to show them in a paper? If yes, what is the purpose of showing them? There aren't that many good reasons to write out the explicit solution of polynomial equations. What is your reason? $\endgroup$ – Szabolcs Nov 18 '16 at 13:17
14
$\begingroup$

Your equation seems to be a casus irreducibilis; the solutions cannot be expressed using only real numbers.

You can make them "nicer" by using Root objects (try RootReduce).

RootReduce@Solve[x^4 - 18 x^2 - 8 x + 21 == 0, x]

{{x -> Root[21 - 8 #1 - 18 #1^2 + #1^4 &, 1]}, {x -> Root[21 - 8 #1 - 18 #1^2 + #1^4 &, 2]}, {x -> Root[21 - 8 #1 - 18 #1^2 + #1^4 &, 3]}, {x -> Root[21 - 8 #1 - 18 #1^2 + #1^4 &, 4]}}

Or, you can use N and Chop to get arbitrary-precision real numbers.

Chop@N@Solve[x^4 - 18 x^2 - 8 x + 21 == 0, x]

{{x -> -3.80007}, {x -> -1.42412}, {x -> 0.896691}, {x -> 4.3275}}

$\endgroup$
  • $\begingroup$ Thanks a lot for the "casus irreducibilis". $\endgroup$ – Jack Nov 18 '16 at 12:36
  • 1
    $\begingroup$ NRoots[x^4 - 18 x^2 - 8 x + 21, x] $\endgroup$ – yode Dec 11 '16 at 18:51
9
$\begingroup$

To make the radical representation explicitly real, use the TargetFunctions option with ComplexExpand

roots = Solve[x^4 - 18 x^2 - 8 x + 21 == 0, x] // 
  ComplexExpand[#, TargetFunctions -> {Abs, Arg}] &

(*  {{x -> 
       -Sqrt[3 + 4*Cos[(1/3)*ArcTan[
                       Sqrt[39]/5]]] - 
         (1/2)*Sqrt[24 - 
               16*Cos[(1/3)*ArcTan[
                       Sqrt[39]/5]] - 
               8/Sqrt[3 + 4*Cos[(1/3)*
                         ArcTan[Sqrt[39]/5]]]]}, 
   {x -> 
       -Sqrt[3 + 4*Cos[(1/3)*ArcTan[
                       Sqrt[39]/5]]] + 
         (1/2)*Sqrt[24 - 
               16*Cos[(1/3)*ArcTan[
                       Sqrt[39]/5]] - 
               8/Sqrt[3 + 4*Cos[(1/3)*
                         ArcTan[Sqrt[39]/5]]]]}, 
   {x -> 
       Sqrt[3 + 4*Cos[(1/3)*ArcTan[
                     Sqrt[39]/5]]] - 
         (1/2)*Sqrt[24 - 
               16*Cos[(1/3)*ArcTan[
                       Sqrt[39]/5]] + 
               8/Sqrt[3 + 4*Cos[(1/3)*
                         ArcTan[Sqrt[39]/5]]]]}, 
   {x -> 
       Sqrt[3 + 4*Cos[(1/3)*ArcTan[
                     Sqrt[39]/5]]] + 
         (1/2)*Sqrt[24 - 
               16*Cos[(1/3)*ArcTan[
                       Sqrt[39]/5]] + 
               8/Sqrt[3 + 4*Cos[(1/3)*
                         ArcTan[Sqrt[39]/5]]]]}}  *)

roots // N

(*  {{x -> -3.80007}, {x -> -1.42412}, {x -> 0.896691}, {x -> 4.3275}}  *)
$\endgroup$
  • 2
    $\begingroup$ Trig expansions... They're never pretty... -- kinda cheating because inverse trig functions actually represent some complex functions: (e.g. ArcTan[z] == Log[(I - z)/(I + z)]/(2 I)) $\endgroup$ – JungHwan Min Nov 18 '16 at 5:20
  • 2
    $\begingroup$ @JHM - Using N the expressions evaluate without any imaginary artifacts and obviate the need to use Chop $\endgroup$ – Bob Hanlon Nov 18 '16 at 5:32
5
$\begingroup$

You can obtain Root objects with

Solve[x^4 - 18 x^2 - 8 x + 21 == 0, x] // FullSimplify

or

Solve[x^4 - 18 x^2 - 8 x + 21 == 0, x] // RootReduce

but numerical roots are perhaps easier to understand.

NRoots[x^4 - 18 x^2 - 8 x + 21 == 0, x]

Convert the output of NRoots with ToRules, and pick the real roots with Cases. Plot the equation with red real roots. I wish I had Manipulate when I was studying calculus.

Manipulate[
   Module[{r = Cases[x/.{ToRules[NRoots[x^4 + a x^2 + b x + c == 0, x]]},_Real]},
      Plot[
         x^4 + a x^2 + b x + c, {x, -5, 5},
         PlotLabel -> ToString@TraditionalForm[x^4+a x^2+b x+c]<>"=0\n roots \[Rule] "<>ToString[r],
         Epilog -> {Red, PointSize[0.02], Point[Thread[List[r, 0]]]},
         Frame -> True, BaseStyle -> {FontSize -> 16}, ImageSize -> 550]],
    {{a, -18.}, -20, 20, Appearance -> "Labeled"},
    {{b, -8.}, -20, 20, Appearance -> "Labeled"},
    {{c, 21.}, -100, 100, Appearance -> "Labeled"}]

polynomial roots

$\endgroup$
5
$\begingroup$

More like a comment.

sol = x /. Solve[x^4 - 18 x^2 - 8 x + 21 == 0, x] // N // Chop

{-3.80007, -1.42412, 0.896691, 4.3275}

The roots may be approximated with

sol2 = RootApproximant[sol, 2]

enter image description here

which turn out to be quite decent approximations:

res = Table[x^4 - 18 x^2 - 8 x + 21 /. x -> sol2[[i]], {i, 1, 4}] // FullSimplify

enter image description here

N @ res

enter image description here

$\endgroup$
2
$\begingroup$

Theres plenty of great answers here but I have some similar ideas I can give you..Maybe not as elegant or as advanced as others but it is straightforward.

 Clear[f, roots]
 f[x_] := x^4 - 18 x^2 - 8 x + 21

I would recommend NSolve because it is a numerical approximation, whereas Solve is solving it explicitly

 roots = NSolve[f[x] == 0, x] 
 ={{x -> -3.80007}, {x -> -1.42412}, {x -> 0.896691}, {x -> 4.3275}}

Checks that roots are right

 f[x] /. roots//Chop
 ={0, 0, 0, 0}

I don't think this offers anymore assistance than what is already here, but oh well. You could even plot some of the roots on a graph of the curve..Say the 1st and 4th root..

 Clear[x1, x2]; 
 x1 = x /. roots[[1]]; 
 x2 = x /. roots[[4]];

 Clear[curve]; 
 curve = Plot[f[x], {x, -6, 6},
 AxesLabel -> {"x", "y"}, Ticks -> None, BaseStyle -> {18, FontFamily -> "Georgia"}]; 

 PtLabel1 = Graphics[Text["( " <> ToString[x1] <> "," <> ToString[f[x1]] <> ")", {x1, f[x1] + 50}]]; 

 PtLabel2 = Graphics[Text["( " <> ToString[x2] <> "," <> ToString[f[x2]] <> ")", {x2, f[x2] + 50}]]; 

 pt1 = Graphics[{PointSize[0.02`], Point[{x1, f[x1]}]}]; 
 pt2 = Graphics[{PointSize[0.02`], Point[{x2, f[x2]}]}]; 
 Show[curve, PtLabel1, PtLabel2, pt1, pt2]
$\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.