Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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]]]]
share|improve this question
4  
FullSimplify[ComplexExpand[ToRadicals[roots]]] –  Daniel Lichtblau Jul 5 '14 at 20:42
    
This ends up throwing N:meprec. –  Matthew Titsworth Jul 5 '14 at 21:11
    
Wrap Quiet around it (it's dealing with zeros that it cannot quite recognize as such). –  Daniel Lichtblau Jul 5 '14 at 21:12
2  
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? –  Mr.Wizard Jan 1 at 0:05
1  
@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. –  Vladimir Reshetnikov Jan 7 at 21:03

1 Answer 1

up vote 13 down vote accepted
+500

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}
share|improve this answer
1  
Thank you. In cases I'm working with, there are often fractional powers of trig functions, and denominators in arguments sometimes exceed 100. –  Vladimir Reshetnikov Jan 6 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. –  Chip Hurst Jan 6 at 21:09
    
@VladimirReshetnikov, could you give more examples? I'd like to see if I could improve my code to work with them. –  Chip Hurst Jan 6 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. –  Matthew Titsworth Jan 21 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. –  Chip Hurst Jan 21 at 19:36

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.