# Transform Root objects into Trigonometric expressions

Consider the Root objects

roots = Table[Root[-1 + 27 #1^2 - 162 #1^4 + 243 #1^6 &, i],{i,1,6}]


These can be expressed in terms trigonometric functions as follows

trig =
{-2/3 Cos[Pi/18], -2/3 Cos[5 Pi/18], -2/3 Cos[7 Pi/18],
2/3 Cos[7 Pi/18], 2/3 Cos[5 Pi/18], 2/3 Cos[Pi/18]}


This can be checked Numerically, but also exactly using the following expression:

And @@
PossibleZeroQ[ToNumberField[#1 - #2], Method -> "ExactAlgebraics"] &,
{roots, trig}]


True

Is there a way to have Mathematica translate between these two things? I have not been able to make FullSimplify do it. Does anyone know of something like a RootToTrig function?

Root[1 - 420 # + 32373 #^2 - 33276 #^3 + 11322 #^4 - 1296 #^5 + 9 #^6 &, 2]


should be converted to

Sin[π/36]^2 Sin[5π/36]^2 / (Sin[7π/36]^2 Sin[2π/9]^2)


Further Examples (by Matthew Titsworth):

Since more examples have been asked for, here is the function that spurred the original asking of this question:

Y[r_, p_] := Table[{(-1)^i Cos[(i^2 r \[Pi])/(2 p + 1)], (-1)^(i-1)^2 Sin[(i^2 r \[Pi])/(2 p + 1)]}, {i, 1, p}]


This contains plenty of examples (e.g. r=1,p=7, r=3,p=4) which do not return to their original form under the transformation

FullSimplify[ComplexExpand[ToRadicals[ToNumberField[Y[r,p],All]]]]

• FullSimplify[ComplexExpand[ToRadicals[roots]]] Jul 5 '14 at 20:42
• This ends up throwing N:meprec. Jul 5 '14 at 21:11
• Wrap Quiet around it (it's dealing with zeros that it cannot quite recognize as such). Jul 5 '14 at 21:12
• Vladimir, this is obviously important to you. Would you please edit the question to include some additional example Root objects of the type you have for ease of experimentation? Jan 1 '15 at 0:05
• @QuantumDot I don't know where you can read about it. But I find it useful, because it could make an expression containing an algebraic quantity more amenable to transformations and simplifications by elementary methods. Jan 7 '15 at 21:03

Disclaimer: This is not a full answer, but perhaps it's a start.

From an algebraic stand point this seems like a very hard problem. I attacked it with a more brute force approach. I guess a basis and use LatticeReduce to try to find a Diophantine relation.

Note this code only tries to identify roots as the product of integral powers of trig. If it returns an answer you can be assured it's correct. If it returns \$Failed, you may not draw any conclusions.

RootToTrig[r_, max_:36] := RootToTrig[r, Range[max]]

RootToTrig[r_, denomGuesses_List] := Module[{redroot, Nr},
redroot = RootReduce[Sign[r]r];
Nr = N[Log[Abs[r]], 30];
Catch[
If[Im[r] != 0, Throw[$$Failed]]; Do[iRootToTrig[redroot, Nr, Sign[r], n], {n, denomGuesses}];$$Failed
]
]

iRootToTrig[r_, Nr_, sign_, n_] := Block[{tbl, V, pos, root},
tbl = Join[Prime[Range[8]], Table[Sin[k π/n], {k, n}]];
tbl = Log[DeleteCases[tbl, 0|1]];
tbl = Union@Replace[tbl, t_Times :> Select[t, FreeQ[Head[#], Integer|Rational]&], {1}];

While[Length[tbl] > 1,
V = LatticeBasis[tbl, Nr];
(* if First[V] == 0, then we have found a trig identity, we will ignore it *)
If[First[V] != 0,
V = Rest[V]/First[V];
Break[]
];

pos = Flatten[Position[V, Except[0], {1}]]-1;
tbl = Delete[tbl, Last[pos]];
];

(* uncomment extra conditions below for integer exponents only *)
If[Length[tbl] <= 1 (* || !VectorQ[V, IntegerQ] || Max[Abs[V]] > 20 *),
Return[]
];

root = Exp[V.tbl];
If[Abs[N[r, 40] - N[root, 40]] < 1.*^-38 && RootReduce[root] == r,
Throw[sign root]
]
]

LatticeBasis[a_List, b_] := Block[{A, prec, basis},
A = Prepend[a, -b];
prec = Ceiling[Precision[A]];
basis = Transpose[Prepend[IdentityMatrix[Length[A]], Round[10^prec A]]];
Rest[First[LatticeReduce[basis]]]
]


This code works on all provided examples:

RootToTrig /@ Table[Root[-1 + 27 #1^2 - 162 #1^4 + 243 #1^6 &, i], {i, 1, 6}]

{-2/3 Cos[π/18], -Csc[π/9]Sec[π/18]/(4 Sqrt[3]), -2/3 Sin[π/9], 2/3 Sin[π/9], Csc[π/9]Sec[π/18]/(4 Sqrt[3]), 2/3 Cos[π/18]}

RootToTrig[Root[1 - 420 # + 32373 #^2 - 33276 #^3 + 11322 #^4 - 1296 #^5 + 9 #^6 &, 2]]//AbsoluteTiming

{3.447089, 1/96 (Sqrt[3]-1)^2 Cos[π/18]^4 Sec[π/9]^4 Sec[5π/36]^4}


Also note if we have a hunch on what the possible denominator should be (or have multiple guesses), you can provide those for a speed up:

RootToTrig[Root[1 - 420 # + 32373 #^2 - 33276 #^3 + 11322 #^4 - 1296 #^5 + 9 #^6 &, 2], {36}]//AbsoluteTiming

{0.570626, 1/96 (Sqrt[3]-1)^2 Cos[π/18]^4 Sec[π/9]^4 Sec[5π/36]^4}


• @VladimirReshetnikov, to get fractional powers in my code, you can remove the condition !VectorQ[V, IntegerQ]. Also if your denominators are larger, you can increase the second argument, or provide a list of denominator guesses. Jan 6 '15 at 21:09
• @MatthewTitsworth Thanks for the accept. I have just made an edit removing the !VectorQ[V, IntegerQ] condition and adding one more example at the bottom of the post. Jan 21 '15 at 19:36