Speed up Eliminate

Question

I have a set of trig equations, c1,c2,c3 are constants, I excepted the result is

c1 c2 c3 r^2 + (c1^2 + c2^2 + c3^2 - 1) r + c1 c2 c3 == 0 but following code worked so slow, is there a faster method do this?

Eliminate[{
  c1 == Cos[a] Sin[b],
  c2 == Cos[b] Sin[c],
  c3 == Cos[c] Sin[a],
  r== Tan[a] Tan[b] Tan[c]}, {a, b, c}]

score 5 · Accepted Answer · answered Jul 19 '13 at 20:22

5

Can be made much more efficient if you replace the trigonometric stuff with explicit algebraic variables. This will involve clearing denominators and also augmenting with more algebraic expressions that enforce the basic trig identities.

eqns = {c1 == Cos[a] Sin[b], c2 == Cos[b] Sin[c], c3 == Cos[c] Sin[a],
    r == Tan[a] Tan[b] Tan[c]};
e2 = Apply[Subtract, eqns, {1}];
e3 = e2 /. {Cos[a_] :> c[a], Sin[a_] :> s[a], Tan[a_] :> s[a]/c[a]};
vars = Variables[e3];
newe = Map[#^2 + s[#[[1]]]^2 - 1 &, Cases[vars, c[_]]];
allexprs = Numerator[Together[Join[e3, newe]]];
elims = Cases[vars, _c | _s];
keep = Complement[vars, elims];

elim = Eliminate[allexprs == 0, elims]

(* Out[75]= c3^2 r + c1 c2 c3 (1 + r^2) == (1 - c1^2 - c2^2) r *)

I often find it easier to use GroebnerBasis rather than Eliminate.

Timing[gb = GroebnerBasis[allexprs, keep, elims]]

(* Out[73]= {0.133516, {c1 c2 c3 - r + c1^2 r + c2^2 r + c3^2 r + 
   c1 c2 c3 r^2}} *)

answered Jul 19 '13 at 20:22

Daniel Lichtblau

58,970
2
101
199

Daniel, I cannot help but notice some rather baroque programming here if I am thinking clearly. Why not e.g. e2 = Subtract @@@ eqns and e3 = e2 /. {Cos -> c, Sin -> s, Tan -> (s[#]/c[#] &)} and most especially newe = Cases[vars, x : c[y_] :> x^2 + s[y]^2 - 1]? I guess the first two could be a matter of clarity but your code for newe just seems needlessly complicated. Please pardon me for what may seem a rather disrespectful question, but actually it is my respect that makes me care why you chose to code this as you did. – Mr.Wizard Jul 21 '13 at 13:02
You are quite correct that it is a bit on the clumsy side. I did not think about the simple Cos->c, etc. rule. I never quite warmed to the @@@ infix (I often avoid infix...). As for your newe = ..., I guess it's a bit out of my range of coding tactics. Strangely enough, I would reverse your analysis though. I think your first two are both simpler and more clear than what I had, whereas the third I find to be a matter of taste. Reason being, as a usage of pattern matching that is not terribly familiar (to me), reconstructing the idea later would become more difficult. – Daniel Lichtblau Jul 21 '13 at 16:29

chyanog · Answer 2 · 2013-07-22T02:01:44.900

Eliminate[{
  c1 == Cos[a] Sin[b],
  c2 == Cos[b] Sin[c],
  c3 == Cos[c] Sin[a],
  t1 == Sin[a] Sin[b] Sin[c],
  t2 == Cos[a] Cos[b] Cos[c],
  r == t1/t2 }, {a, b, c, t1, t2}]

(*c3^2 r + c1 c2 c3 (1 + r^2) == (1 - c1^2 - c2^2) r*)


Eliminate[{
  c1 == Cos[a] Sin[b],
  c2 == Cos[b] Sin[c], 
  c3 == Cos[c] Sin[a], 
  (Cos[a] Cos[b] Cos[c]) r == Sin[a] Sin[b] Sin[c] },
 {a, b, c}]

(*c3^2 r + c1 c2 c3 (1 + r^2) == (1 - c1^2 - c2^2) r*)

b.gates.you.know.what · Answer 3 · 2013-07-18T12:01:17.707

You can use Solve and take care of the uninteresting periodicity by hand (this last step only for speed) :

sol = Solve[{c1 == Cos[a] Sin[b], c2 == Cos[b] Sin[c], c3 == Cos[c] Sin[a]}, {a, b, c}] 
 /. {C[1] -> 0, C[2] -> 0, C[3] -> 0};

You will get several equivalent solutions which boil down to :

Union[FullSimplify[(Tan[a] Tan[b] Tan[c] /. #)] & /@ sol]
(* {-((-1 + c1^2 + c2^2 + c3^2 - Sqrt[(-1 + c1^2 + c2^2 - 2 c1 c2 c3 + c3^2) (-1 + c1^2 + c2^2 + 2 c1 c2 c3 + c3^2)])/(2 c1 c2 c3)),
    -((-1 + c1^2 + c2^2 + c3^2 + Sqrt[(-1 + c1^2 + c2^2 - 2 c1 c2 c3 + c3^2) (-1 + c1^2 + c2^2 + 2 c1 c2 c3 + c3^2)])/(2 c1 c2 c3))}
*)

Speed up Eliminate

3 Answers3

Linked

Related