# Computing the seven roots of a polynomial

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.

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 Solve:

Apply[Join, Solve[First@# == 0, x] & /@ fl] 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] &] 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}}  *)

• Note 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 Jan 12 '19 at 20:59
• @murray Yes, it does. This is a bit faster: FullSimplify @ TrigToExp@Activate[poly /. roots]. – Michael E2 Jan 12 '19 at 21:01