How to solve this trig equation with Mathematica?

Question

The Reduce command of Mathematica is powerful. However, both Reduce and FindInstance are not able to solve $$\sqrt{18 | \tan (x)| +6 | \cot (x)| +21}+\sqrt{4 | \tan (4 x)| +12 | \cot (4 x)| +19}=3 \sqrt{3}+7 $$ over the reals running without any response during a long time. I solve it in such a way. First, the result of

Plot[Sqrt[21 + 18*RealAbs[Tan[x]] + 6*RealAbs[Cot[x]]] + 
Sqrt[19 + 4*RealAbs[Tan[4 x]] + 12*RealAbs[Cot[4 x]]] - 7 - 
3*Sqrt[3], {x, -Pi/2, Pi/2}, PlotRange -> {-1, 1}]

shows two roots near $-0.5$ and $0.5$. Now

FindRoot[Sqrt[21 + 18*RealAbs[Tan[x]] + 6*RealAbs[Cot[x]]] + 
Sqrt[19 + 4*RealAbs[Tan[4 x]] + 12*RealAbs[Cot[4 x]]] - 7 - 
3*Sqrt[3], {x, 0.5}]

{x -> 0.523599}

and

6*0.5235987628872519

3.14159

suggest that $-\frac \pi 6$ and $\frac \pi 6$ are the solutions on $(-\frac \pi 2,-\frac \pi 2)$. The verification confirms it. How to prove with Mathematica these are the only solutions of the equation under consideration on that interval? What are other ways to symbolically solve that equation with Mathematica?

Answer 1

eqn = Sqrt[21 + 18 Abs[Tan[x]] + 6 Abs[Cot[x]]] + Sqrt[19 + 4 Abs[Tan[4 x]] + 12 Abs[Cot[4 x]]] - 7 - 3 Sqrt[3] == 0;
RootReduce@Reduce[ExpandAll[eqn /. x -> ArcTan[t], Trig -> True], t, Reals] /. t -> Tan[x]
Solve[% && -Pi/2 < x < Pi/2, x]

$\tan (x)=\frac{1}{\sqrt{3}}\lor \tan (x)=-\frac{1}{\sqrt{3}}$

$\left\{\left\{x\to -\frac{\pi }{6}\right\},\left\{x\to \frac{\pi }{6}\right\}\right\}$

Answer 2

$Version

(* "13.3.1 for Mac OS X ARM (64-bit) (July 24, 2023)" *)

Clear["Global`*"]

eqn = Sqrt[21 + 18 Abs[Tan[x]] + 6 Abs[Cot[x]]] + 
    Sqrt[19 + 4 Abs[Tan[4 x]] + 12 Abs[Cot[4 x]]] == 3 Sqrt[3] + 7;

Since we are dealing with reals,

eqn2 = eqn /. Abs[t_] :> Sqrt[t^2]

(* Sqrt[21 + 6 Sqrt[Cot[x]^2] + 18 Sqrt[Tan[x]^2]] + Sqrt[
  19 + 12 Sqrt[Cot[4 x]^2] + 4 Sqrt[Tan[4 x]^2]] == 7 + 3 Sqrt[3] *)

Finding approximate solutions

(sol = NSolve[{eqn2, -Pi/2 < x < Pi/2}, x, Reals]) // 
  AbsoluteTiming

(* {0.119084, {{x -> -0.523599}, {x -> 0.523599}}} *)

Converting to algebraic numbers,

sol2 = sol /. r_Real :> RootApproximant[r/Pi]*Pi

(* {{x -> -(π/6)}, {x -> π/6}} *)

Verifying that the algebraic numbers are the actual solutions

eqn /. sol2

(* {True, True} *)

Answer 3

Plotting this function with almost your code:

Plot[Sqrt[21 + 18*RealAbs[Tan[x]] + 6*RealAbs[Cot[x]]] + 
  Sqrt[19 + 4*RealAbs[Tan[4 x]] + 12*RealAbs[Cot[4 x]]] - 7 - 
  3*Sqrt[3], {x, 0.5, 0.55}, PlotRange -> {-0.0005, 0.001}]

we get the following:

That is, the solution is either in the minimum point or somewhere in its close vicinity.

Let us find the point of minimum for x>0:

    eq = (D[Sqrt[21 + 18*RealAbs[Tan[x]] + 6*RealAbs[Cot[x]]] + 
          Sqrt[19 + 4*RealAbs[Tan[4 x]] + 12*RealAbs[Cot[4 x]]] - 7 - 
          3*Sqrt[3], x] // Simplify[#, x > 0] &) == 0
FindRoot[eq, {x, 0.5}]

(* {x -> 0.523599} *)

Now, let us use this solution as a starting point for the solution of the initial equation:

FindRoot[
 Sqrt[21 + 18*RealAbs[Tan[x]] + 6*RealAbs[Cot[x]]] + 
   Sqrt[19 + 4*RealAbs[Tan[4 x]] + 12*RealAbs[Cot[4 x]]] - 7 - 
   3*Sqrt[3] == 0, {x, 0.5235987755982988`}]

(*  {x -> 0.523599}  *)

Have fun!

Answer 4

Here is my answer. The plot suggests that the LHS is greater than or equal to the RHS. In view of it I find

Minimize[{Sqrt[21 + 18*y + 6/y], y >= 0}, y]

{Sqrt[21 + 12 Sqrt[3]], {y -> 1/Sqrt[3]}}

and

Minimize[{Sqrt[19 + 4*z + 12/z], z >= 0}, z]

{Sqrt[19 + 8 Sqrt[3]], {z -> Sqrt[3]}}

Indeed,

FullSimplify[Sqrt[21 + 12 Sqrt[3]]+Sqrt[19 + 8 Sqrt[3]]-7-3*Sqrt[3]]

0

Finally,

Reduce[RealAbs[Tan[x]] == 1/Sqrt[3]&&RealAbs[Tan[4*x]] == Sqrt[3], x, Reals]

(C[1] \[Element] Integers && (x == -((5 \[Pi])/6) + 2 \[Pi] C[1] || x == \[Pi]/6 + 2 \[Pi] C[1])) || (C[1] \[Element] Integers && (x == -(\[Pi]/6) + 2 \[Pi] C[1] || x == (5 \[Pi])/6 + 2 \[Pi] C[1]))