8
$\begingroup$

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?

$\endgroup$

4 Answers 4

15
$\begingroup$
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\}$

$\endgroup$
1
  • $\begingroup$ Sorry for the delay in reply. I was out of MMA some time. $\endgroup$
    – user64494
    Dec 16, 2023 at 19:36
5
$\begingroup$
$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} *)
$\endgroup$
2
$\begingroup$

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:

enter image description here

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!

$\endgroup$
2
  • $\begingroup$ Sorry, I don't find your approximate solution useful. $\endgroup$
    – user64494
    Dec 26, 2023 at 19:25
  • $\begingroup$ @user64494 That's up to you. $\endgroup$ Dec 28, 2023 at 19:03
1
$\begingroup$

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]))

$\endgroup$
1
  • 1
    $\begingroup$ Mathematica knows and uses the above method, but the equation under consideration is too difficult for her. $\endgroup$
    – user64494
    Dec 16, 2023 at 20:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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