How to help Eliminate simplify simultaneous equations

Question

I have a set of three moderately simple simultaneous equations that I'd like to simplify and eliminate a set of variables for (this is a simple example of a more general class of problem - but I'd like to get the simple example working before starting on the bigger ones). Asking Mathematica to Eliminate two of the three variables I'd like to remove and then simplifying the result gets me to the answer fairly quickly: however asking Mathematica to Eliminate all three of the variables at once hangs. Are there any tricks I can use to help Eliminate with this task, or generalisations of it?

My example has three matrices (adjoint representation of so(3) for the interested)

b1 = {{0, 0, 0}, {0, 0, 1}, {0, -1, 0}}; 
b2 = {{0, 0, -1}, {0, 0, 0}, {1, 0, 0}}; 
b3 = {{0, 1, 0}, {-1, 0, 0}, {0, 0, 0}};

and then the equations are

{xt1, xt2, xt3} == {x1, x2, x3}.MatrixExp[t1 b1].MatrixExp[t2 b2].MatrixExp[t3 b3]

where I would like to eliminate the t1, t2, and t3 variables.

Running this to eliminate t1 and t2 gives

Timing@Simplify@Eliminate[{xt1, xt2, xt3} == {x1, x2, x3}.MatrixExp[t1 b1].MatrixExp[t2 b2].MatrixExp[t3 b3], {t1, t2}]

{40.375, x1^2 + x2^2 + x3^2 == xt1^2 + xt2^2 + xt3^2}

which is the correct answer. However,

Timing@Eliminate[{xt1, xt2, xt3} == {x1, x2, x3}.MatrixExp[t1 b1].MatrixExp[t2 b2].MatrixExp[t3 b3], {t1, t2, t3}]

runs forever (at least four hours on my laptop). How can I make Eliminates life easier, or are there other tools I could try to solve this system of equations? (Extra information if helpful: the functional form of the reduced solution(s) to members of this class of equations will always have the same functional form in the xt variables and the x variables, although the actual functional form is unknown - I'm not sure if this can be leveraged within Mathematica to help?)

Answer 1

Setup:

b1 = {{0, 0, 0}, {0, 0, 1}, {0, -1, 0}};
b2 = {{0, 0, -1}, {0, 0, 0}, {1, 0, 0}};
b3 = {{0, 1, 0}, {-1, 0, 0}, {0, 0, 0}};
sys = {xt1, xt2, xt3} == {x1, x2, x3} . MatrixExp[t1 b1] . 
    MatrixExp[t2 b2] . MatrixExp[t3 b3];

---

Eliminating three variables from the three equations sequentially works quickly:

Quiet[
 Eliminate[
  Eliminate[
   Eliminate[sys,
    {t3}],
   {t2}],
  {t1}],
 Eliminate::ifun]

(*  -x2^2 - x3^2 + xt1^2 + xt2^2 + xt3^2 == x1^2  *)

---

Eliminating six variables from six equations (@Akku14's rationalization) works, too, but it takes a few seconds:

Eliminate[{sys,
  Sin[t1]^2 + Cos[t1]^2 == 1, 
  Sin[t2]^2 + Cos[t2]^2 == 1,
  Sin[t3]^2 + Cos[t3]^2 == 1},
 {Sin[t3], Cos[t3], Sin[t2], Cos[t2], Sin[t1], Cos[t1]}]

(*  xt3^2 == x1^2 + x2^2 + x3^2 - xt1^2 - xt2^2  *)

Answer 2

The quite fastest way is to use Solve, which is not sensitive if some variables are not independent of each other, add identities for Sin, Cos and eliminate all Sin und Cos at the same time.

Solve[{xt1 == 
Cos[t3] (x1 Cos[t2] + (x3 Cos[t1] + x2 Sin[t1]) Sin[t2]) - (x2 Cos[
     t1] - x3 Sin[t1]) Sin[t3], 
xt2 == Cos[
  t3] (x2 Cos[t1] - 
   x3 Sin[t1]) + (x1 Cos[t2] + (x3 Cos[t1] + x2 Sin[t1]) Sin[
     t2]) Sin[t3], 
xt3 == Cos[t2] (x3 Cos[t1] + x2 Sin[t1]) - x1 Sin[t2], 
Sin[t1]^2 + Cos[t1]^2 == 1, Sin[t2]^2 + Cos[t2]^2 == 1, 
Sin[t3]^2 + Cos[t3]^2 == 1}, {xt1, xt2, xt3}, {Sin[t1], Sin[t2], 
Cos[t1], Cos[t2]}]

(*   Solve::svars: Equations may not give solutions for all "solve" variables. >>

{{xt3 -> -Sqrt[x1^2 + x2^2 + x3^2 - xt1^2 - xt2^2]}, 
 {xt3 -> Sqrt[x1^2 + x2^2 + x3^2 - xt1^2 - xt2^2]}}     *)

And the same result for all ti with

Solve[{xt1 == 
Cos[t3] (x1 Cos[t2] + (x3 Cos[t1] + x2 Sin[t1]) Sin[t2]) - (x2 Cos[
     t1] - x3 Sin[t1]) Sin[t3], 
xt2 == Cos[
  t3] (x2 Cos[t1] - 
   x3 Sin[t1]) + (x1 Cos[t2] + (x3 Cos[t1] + x2 Sin[t1]) Sin[
     t2]) Sin[t3], 
xt3 == Cos[t2] (x3 Cos[t1] + x2 Sin[t1]) - x1 Sin[t2], 
Sin[t1]^2 + Cos[t1]^2 == 1, Sin[t2]^2 + Cos[t2]^2 == 1, 
Sin[t3]^2 + Cos[t3]^2 == 1}, {xt1, xt2, xt3}, {Sin[t1], Sin[t2], 
Sin[t3], Cos[t1], Cos[t2], Cos[t3]}]

Answer 3

If I use the Weierstrass substitution along with TrigExpand[], GroebnerBasis[] accomplishes the elimination pretty quickly:

GroebnerBasis[TrigExpand[Thread[{xt1, xt2, xt3} == {x1, x2, x3} . MatrixExp[t1 b1] .
                                                   MatrixExp[t2 b2] . MatrixExp[t3 b3]] /.
                         Thread[{t1, t2, t3} -> {2 ArcTan[u1], 2 ArcTan[u2], 2 ArcTan[u3]}]],
              {xt1, xt2, xt3, x1, x2, x3}, {u1, u2, u3}]
   {-x1^2 - x2^2 - x3^2 + xt1^2 + xt2^2 + xt3^2}

which is equivalent to the answer Michael gave.