Computing the seven roots of a polynomial

9

3

This question was originally asked by @fsrong70 six months ago. The OP deleted it shortly after posting and has not returned to this site since. I had just figured it out when it was deleted. I waited to see if the OP would repost it, but not yet. So I'm posting it with my solution.


Considering the solution to the following equation

$x^7+x^6-18 x^5-35 x^4+38 x^3+104 x^2+7 x-49=0$

poly = x^7 + x^6 - 18 x^5 - 35 x^4 + 38 x^3 + 104 x^2 + 7 x - 49;

This problem could be solved using notions from Galois theory and the Galois group of a polynomial, and the 43rd root of unity ($\displaystyle e^\frac{2i\pi}{43}$) .

The solutions are expressed in terms of trigonometric (cosine) functions. The seven solutions are:

$\displaystyle \alpha_1 = 2\cos(\frac{2\pi}{43}) + 2\cos(\frac{12\pi}{43}) + 2\cos(\frac{14\pi}{43})$

$\displaystyle \alpha_2 =2\cos(\frac{4\pi}{43}) + 2\cos(\frac{24\pi}{43}) + 2\cos(\frac{28\pi}{43})$

$\displaystyle \alpha_3 = 2\cos(\frac{6\pi}{43}) + 2\cos(\frac{36\pi}{43}) + 2\cos(\frac{42\pi}{43})$

$\displaystyle \alpha_4 =2\cos(\frac{8\pi}{43}) + 2\cos(\frac{30\pi}{43}) + 2\cos(\frac{38\pi}{43})$

$\displaystyle \alpha_5 =2\cos(\frac{10\pi}{43}) + 2\cos(\frac{16\pi}{43}) + 2\cos(\frac{24\pi}{43})$

$\displaystyle \alpha_6 =2\cos(\frac{18\pi}{43}) + 2\cos(\frac{22\pi}{43}) + 2\cos(\frac{40\pi}{43})$

$\displaystyle \alpha_7 =2\cos(\frac{20\pi}{43}) + 2\cos(\frac{32\pi}{43}) + 2\cos(\frac{34\pi}{43})$

Might this problem be entirely solved and the symbolic solutions computed with Mathematica?

This problem was asked and solved on Quora, but not in relation to Mathematica.

Michael E2

Posted 2019-01-12T20:45:45.877

Reputation: 190 928

Answers

11

poly = x^7 + x^6 - 18 x^5 - 35 x^4 + 38 x^3 + 104 x^2 + 7 x - 49;

Find an extension in which the polynomial splits:

PrintTemporary@Dynamic@{Clock[Infinity], n};
Catch[
  Do[
   fl = DeleteCases[
     FactorList[poly, Extension -> Exp[2 Pi*I/n]], {_?NumericQ, _Integer}];
   If[Total[fl[[All, 2]]] > 1, Throw[n -> fl]], {n, 
    Rest@Divisors@Discriminant[poly, x]}]
  ] // AbsoluteTiming

Mathematica graphics

Solve:

Apply[Join, Solve[First@# == 0, x] & /@ fl]

Mathematica graphics

Cosmetic clean-up:

roots = Expand[
    Apply[Join, Solve[First@# == 0, x] & /@ fl] /. -1 + rest__ :> 
      Simplify[Sum[2 Cos[2 Pi/43*k], {k, 21}] + rest]
    ] /. {2 Sin[t_] :> 2 Inactive[Cos][Pi/2 - t],
         -2 Sin[t_] :> 2 Inactive[Cos][Pi/2 + t],
         -2 Cos[t_] :> 2 Inactive[Cos][Pi + t],
          2 Cos[t_] :> 2 Inactive[Cos][t]} // 
  SortBy[Min@Cases[#, Inactive[Cos][t_] :> N@t, Infinity] &]

Mathematica graphics

Note there's an error in $a_5$ in the OP.

Update: Here's the fastest way I've found to verify:

FullSimplify@TrigToExp@Activate[poly /. roots] // AbsoluteTiming
(*  {4.84673, {0, 0, 0, 0, 0, 0, 0}}  *)

Michael E2

Posted 2019-01-12T20:45:45.877

Reputation: 190 928

2Note that substituting the roots into poly and using Simplify to see if they satisfy it takes a very long time. (Using N after substituting gives verification almost immediately, rhough.) – murray – 2019-01-12T20:59:51.750

@murray Yes, it does. This is a bit faster: FullSimplify @ TrigToExp@Activate[poly /. roots]. – Michael E2 – 2019-01-12T21:01:05.623

0

You need to solve this problem with Magma software. If the Galois group of a polynomial is solvable, Magma can give all of its root solutions.

> P<x> := PolynomialRing(IntegerRing()); 
> f := x^7 + x^6 - 18* x^5 - 35 *x^4 + 38* x^3 + 104* x^2 + 7* x - 49;
> G:=GaloisGroup (f);
> G;
> IsCyclic (G);
> IsSolvable (G);
> K, R := SolveByRadicals(f:Name := "K."); 
> K:Maximal; 
> R;

The result we get back is

Permutation group G acting on a set of cardinality 7
Order = 7
    (1, 3, 6, 7, 2, 5, 4)
true
true
The computation exceeded the time limit and so was terminated prematurely.

You may need a desktop version of Magma to be free of computing time constraints (In fact,before v2.25-2, the magma web page version can calculate the results within the specified time. It is estimated that the new web version of magma in a few months will fix this bug).

But the following example can get the calculation result

> P<x> := PolynomialRing(IntegerRing());
> f := x^6 - x^5 - 6*x^4 + 7*x^3 + 4*x^2 - 5*x + 1;
> K, R := SolveByRadicals(f:Name := "K.");
> K:Maximal;

  K<K.1>

     |

     |
  $1<K.2>
     |

     |
  $2<K.3>
     |
     |
  $3<K.4>
     |

     |
    Q

K  : K.1^3 + 1/2*(3*K.4 - 11)*K.3 + 1/2*(-27*K.4 + 23)
$1 : K.2^3 - 114*K.4*K.3 - 494
$2 : K.3^2 - 5
$3 : K.4^2 + 3
> [ Evaluate(f, x) eq 0 : x in R];
[ true, true, true, true, true, true ]

K.4 is a solution of k.4 ^ 2 + 3. Let k.4 = sqrt [- 3] K.3 is a solution of K.3 ^ 2 - 5. Let K.3 = sqrt [5]

K.2 is a solution of K.2^3 - 114*K.4*K.3 - 494,that's a solution of K.2^3 - 114*Sqrt[-15] - 494,Let k.2=K.2=Power[38 (13+3 Sqrt[-15]), (3)^-1]

K.1 is a solution of K.1^3 + 1/2*(3*K.4 - 11)K.3 + 1/2(-27*K.4 + 23),that's a solution of K.1^3 + 1/2*(3*Sqrt[-3] - 11)Sqrt[5] + 1/2(-27*Sqrt[-3] + 23),Let K.1=I Power[1/2 (-23 I-27 Sqrt[3]+11 Sqrt[-5]+3 Sqrt[15]), (3)^-1]

So one of the roots of f := x^6 - x^5 - 6*x^4 + 7*x^3 + 4*x^2 - 5*x + 1 is

(1/456*(-3*K.4 + 7)*K.3 + 1/456*(-27*K.4 - 13))*K.1^2 + 1/3*K.1 + 1/6*K.3 + 1/6
=(1/456*(-3*Sqrt[-3] + 7)*Sqrt[5] + 1/456*(-27*Sqrt[-3] - 13))*I Power[1/2 (-23 I-27 Sqrt[3]+11 Sqrt[-5]+3 Sqrt[15]), (3)^-1]^2 + 1/3*I Power[1/2 (-23 I-27 Sqrt[3]+11 Sqrt[-5]+3 Sqrt[15]), (3)^-1] + 1/6*Sqrt[5] + 1/6 

A little mouse on the pampas

Posted 2019-01-12T20:45:45.877

Reputation: 4 904

1But this isn't a Mathematica solution... – J. M.'s ennui – 2020-01-26T11:29:56.327