Need help in solving a trigonometric equation

Question

How can I solve the following equation?

w^2 -(2*w^2*Sin[w] + w^2*Sin[w] + w^3 + w^3*Cot[w]*Sin[w])/
  (Sin[w]+2*Cot[w]*(Sin[w])^2 - 2*w - 2*w*Cot[w]*Sin[w]) = 0 

Answer 1

To make it a bit easier for typing purposes, let's define a function of w for your expression.

f[w_] := w^2 - (2*w^2*Sin[w] + w^2*Sin[w] + w^3 + 
     w^3*Cot[w]*Sin[w])/(Sin[w] + 2*Cot[w]*(Sin[w])^2 - 2*w - 
     2*w*Cot[w]*Sin[w])

Plot the function to get an idea of where the zeros occur.

Plot[f[w], {w, -6 π, 6 π}, PlotStyle -> Black]

Note that it appears to be zero at w=0. However you need to take a limit because the expression is zero/zero.

Limit[f[w], w -> 0]
(* 0 *)

One can use Solve or Reduce to give an answer over a certain range.

sol = Solve[{f[w] == 0, -2 π < w < 2 π}, w]
(* {{w -> 
   Root[{2 Sin[#1] - 2 Cos[#1] Sin[#1] + 3 #1 + 
       3 Cos[#1] #1 &, -3.7631414554458760041}]}, {w -> 
   Root[{2 Sin[#1] - 2 Cos[#1] Sin[#1] + 3 #1 + 3 Cos[#1] #1 &, 
     3.7631414554458760041}]}} *)

Those strange looking Root expressions can be numerically evaluated as follows.

First we use Part to extract the expressions and subsequently apply N to get the numerical value.

sol[[1, 1, 2]] // N
(* -3.76314 *)

sol[[2, 1, 2]] // N
(* 3.76314 *)

Reduce gives a similar result. Reduce typically is more robust than Solve for challenging cases.

Reduce[{f[w] == 0, -2 π < w < 2 π}, w]
(* w == 
  Root[{2 Sin[#1] - 2 Cos[#1] Sin[#1] + 3 #1 + 
      3 Cos[#1] #1 &, -3.7631414554458760041}] || 
 w == Root[{2 Sin[#1] - 2 Cos[#1] Sin[#1] + 3 #1 + 3 Cos[#1] #1 &, 
    3.7631414554458760041}] *)

Answer 2

Using NSolve

f[w_] = w^2 - (2*w^2*Sin[w] + w^2*Sin[w] + w^3 + w^3*Cot[w]*Sin[w])/
     (Sin[w] + 2*Cot[w]*(Sin[w])^2 - 2*w - 2*w*Cot[w]*Sin[w]) //
   Together // FullSimplify

(* (w^2*(3*w*Cos[w/2] + 4*Sin[w/2]^3))/(2*w*Cos[w/2] - Sin[(3*w)/2]) *)

f[w] == f[-w] // Simplify

(* True *)

The function is even so it is only necessary to find the nonnegative roots to know all of the roots.

The function oscillates so the number of solutions depends on the range of interest.

(soln = NSolve[{f[w] == 0, 0 <= w < 20}, w, WorkingPrecision -> 25]) // 
   Column

Verifying the solutions

f[w] /. soln // Chop[#, 10^-20] &

(* Power::infy: Infinite expression 1/0 encountered.

Infinity::indet: Indeterminate expression 0 ComplexInfinity encountered.

{Indeterminate, 0, 0, 0} *)

The solution at w == 0 is a limiting case

Limit[f[w], w -> 0]

(* 0 *)

Plot[f[w], {w, 0, 16.5}, PlotRange -> {-20, 20},
 Epilog -> {Red, AbsolutePointSize[6], Point[{w, 0} /. soln]}]

Answer 3

Another solution could be extract the coordinates of the intersection points directly from the plot (see this question).

First, I have simplified the equation (following the suggestion from @J.M.):

w^2 - (2*w^2*Sin[w] + w^2*Sin[w] + w^3 + w^3*Cot[w]*Sin[w])/(Sin[w] + 
  2*Cot[w]*(Sin[w])^2 - 2*w - 2*w*Cot[w]*Sin[w]) ==  0 // FullSimplify

(* w^2 (1 + (w + w Cos[w] + 3 Sin[w])/(2 w (1 + Cos[w]) - (1 + 2 Cos[w]) Sin[w])) == 0 *)

So one solution is $w=0$, though this is clear from the original equation.

Now the second condition is:

(w + w Cos[w] + 3 Sin[w])/(2 w (1 + Cos[w]) - (1 + 2 Cos[w])Sin[w]))==-1

and it will gives more solutions.

Plotting both terms:

and only their intersections:

zeros = Plot[{(w + w Cos[w] + 3 Sin[w])/(2 w (1 + Cos[w]) - (1 + 2 Cos[w])Sin[w]), -1}, {w, -8 \[Pi], 8 \[Pi]}, 
MeshFunctions -> {Function[{w, f}, 
 1 + (w + w Cos[w] + 3 Sin[w])/(2 w (1 + Cos[w]) - (1 + 2 Cos[w]) Sin[w])]}, Mesh -> {{0}}, 
MeshStyle -> Red, PlotStyle -> Directive[Opacity[0]]]

Finally we extract the coordinates of this points (it seems that the function is undocumented as I could not get any information from MMA reference):

intersections = Graphics`Mesh`FindIntersections[zeros]

(* {{-22.1116, -1.}, {-15.8751, -1.}, {-9.69343, -1.}, {-3.76328, -1.},
   {3.76327, -1.}, {9.6937, -1.}, {15.8744, -1.},{22.1116, -1.}} *)

If you want more roots, just move the PlotRange. This is so because if you expand the x-axis, the plot could not have enough resolution to obtain all the intersections.