How to expand tan(x+y) as normal form?

Question

TrigExpand@Tan[x + y]

gives

$\frac{\sin (x) \cos (y)}{\cos (x) \cos (y)-\sin (x) \sin (y)}+\frac{\cos (x) \sin(y)}{\cos (x) \cos (y)-\sin (x) \sin (y)}$

but I expected

$\frac{\tan (x)+\tan (y)}{1-\tan (x) \tan (y)}$

Evaluating TrigExpand with arguments $\tan (x-y)$ or $\tan (3*x)$ also returns results in terms of sine and cosine. What should I do to get results in terms of the tangent?

Answer 1

One way to induce Mathematica to simplify to Tan functions is to introduce the arguments as inverse tangents, as in $x\equiv \arctan a$ and $y\equiv \arctan b$. Then you could write for example

Simplify[
  TrigExpand@Tan[ArcTan[a] + ArcTan[b]]] /. {a -> Tan[x], b -> Tan[y]}

(* ==> (Tan[x] + Tan[y])/(1 - Tan[x] Tan[y]) *)

or more generally with an expression containing x and y:

expr = Tan[3 x];

Simplify[TrigExpand[
   expr /. {x -> ArcTan[a], y -> ArcTan[b]}]] /. {a -> Tan[x], 
  b -> Tan[y]}

(* ==> (Tan[x] (-3 + Tan[x]^2))/(-1 + 3 Tan[x]^2) *)

Edit

Referring to the answer by @belisarius, I thought it's worth pointing out that you can achieve similar flexibility with my approach. For example, if you want the expression simplified in terms of Sin instead of Tan, just use inverse sines where I said to use inverse tangents above:

Simplify[TrigExpand[
      expr /. {x -> ArcSin[a], y -> ArcSin[b]}]] /. {a -> Sin[x], 
    b -> Sin[y]}

(*
==> (Sin[x] (-3 + 4 Sin[x]^2))/(Sqrt[
 1 - Sin[x]^2] (-1 + 4 Sin[x]^2))
*)

The insertion of the inverse function causes Simplify to see the expression as more complex until it reaches a form in terms of the inverse variables. When the simplification is done, we revert the variables back without invoking Simplify again.

You can try this with any target function that has an inverse.

Answer 2

You may use this function I wrote for transforming more general trig expressions:

trigSet[exp_, inTerm_] := 
 Module[{trigSyms, rels, set, setRep, setRep1, toLow, oneInTermsOf, 
                                                        allInTermsOf, fq, ruleAll, convert},
  trigSyms = {Sin, Cos, Tan, Cot, Sec, Csc};
  rels     = {csc sin == 1, cos^2 + sin^2 == 1, 1 == cos sec, tan == sin/cos, cot tan == 1};
  set      = ToExpression /@ ToLowerCase /@ SymbolName /@ trigSyms;
  setRep   = Thread[set -> (ToExpression /@ (StringJoin[#, "[x_]"] & /@ ToString /@ set))];
  setRep1  = Thread[set -> (ToExpression /@ (StringJoin[#, "[x]"] & /@  ToString /@ set))];
  toLow    = Thread[trigSyms -> set];

  oneInTermsOf[one_, of_] := Solve[rels, {one}, Complement[set, {one, of}]];
  allInTermsOf[of_]       := Flatten[oneInTermsOf[#, of] & /@ Complement[set, {of}]];
  fq[x_, y_]              := FreeQ[x, Alternatives @@ Complement[set, {y}]];
  ruleAll[of_] := Rule @@@ Transpose[{#[[1]] /. setRep, #[[2]] /. setRep1} &@
                                                     Transpose@(List @@@ allInTermsOf[of])];
  convert[expr_, inTerms_] := FullSimplify@ Union@Select[
        Flatten@NestWhile[# /. (List /@ ruleAll[inTerms]) &, {TrigExpand[expr] /. toLow }, 
                              ! Or @@ (fq[#, inTerms] & /@ Flatten@#) &], fq[#, inTerms] &];
  HoldForm[ Evaluate@convert[exp, inTerm]] /. (Reverse /@ toLow)
  ]

Use it this way:

trigSet[Tan[x + y], tan]
(*
 {(Tan[x]+Tan[y])/(-1+Tan[x] Tan[y]),(Tan[x]+Tan[y])/(1-Tan[x] Tan[y])}
*)

You can also try

trigSet[Tan[x + y], sin]

to get the result in terms of Sin[], etc

trigSet[Tan[3 x], tan]
(*
 ((Tan[x] (-3+Tan[x]^2))/(-1+3 Tan[x]^2))
*)

or

trigSet[Tan[x - y], tan]
(*
 -> {(Tan[x]+Tan[y])/(-1+Tan[x] Tan[y]),(Tan[x]+Tan[y])/(1-Tan[x] Tan[y])}
*)

Edit

Usually those trig expressions have more than one form depending on the signs of the involved square roots.

For example:

s = Cos[x] Sin[x]; (*The function to match*)
s0 = ReleaseHold@trigSet[s, sin](*the candidates*)
(*
{-Sin[x] Sqrt[1 - Sin[x]^2], Sin[x] Sqrt[1 - Sin[x]^2]}
*)

If you want to build up the piecewise function you could do something like:

s1 = FullSimplify[Reduce[# == s, x, Reals] & /@ s0] ; (*the validity domains*)
hh[x_] := Piecewise[Transpose@{s0, ReplaceAll[#, ((xx : Element[u__, __]) && z__) -> 
                                       Hold@Resolve[Exists[u, xx, z], Reals]] & /@ s1}]