# 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 @@
MapThread[
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?

Example (by Vladimir Reshetnikov):

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, 2014 at 20:42
• This ends up throwing N:meprec. Jul 5, 2014 at 21:11
• Wrap Quiet around it (it's dealing with zeros that it cannot quite recognize as such). Jul 5, 2014 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, 2015 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, 2015 at 21:03

## 1 Answer

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}


A more robust approach is to use the AskConstants package [download link] [WTC presentation]:

• Thank you. In cases I'm working with, there are often fractional powers of trig functions, and denominators in arguments sometimes exceed 100. Jan 6, 2015 at 21:02
• @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, 2015 at 21:09
• @VladimirReshetnikov, could you give more examples? I'd like to see if I could improve my code to work with them. Jan 6, 2015 at 21:10
• A family of examples have been added. In my work fairly arbitrary products of these can show up, but handling that use case is likely problematic. This seems to be a good answer for the moment that can be updated as necessary, so I'm going to mark it as the accepted answer for the question. Jan 21, 2015 at 19:27
• @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, 2015 at 19:36