2
$\begingroup$

We have a function same as

f[x_]=Cos[x] Cos[2 x] + I Sin[x] Sin[2 x]

The final objective is to find all extremums of Abs[f[x]] in [0,2 pi]. But in the first step there is a problem because Abs[x + I y] != Sqrt[x^2+y^2] except x and y be numeric. Also, in any trick Function same as: FindMaximum could not help for finding ALL of extremums. How can I find MAX and MIN of Abs[f[x]] with their values of x and f[x]?

$\endgroup$
6
$\begingroup$

The problem can be completely solved symbolically using the standard methods. Here we go.

The function in question is given by

f[x_] := Cos[x] Cos[2 x] + I Sin[x] Sin[2 x]

The square of the absolute value for real x is then

fa[x_] = ComplexExpand[f[x]*Conjugate[f[x]]] // Simplify

(*
Out[94]= Cos[x]^2 (2 - 2 Cos[2 x] + Cos[4 x])
*)

The extrema of Abs[f[x]] are in the same location as those of fa[x].

Looking for zeroes in the derivative gives

eq = D[fa[x], x] == 0 // Simplify

(*
Out[98]= Cos[x] (4 Sin[x] - 3 Sin[3 x] + 3 Sin[5 x]) == 0
*)

sol = Solve[eq && 0 <= x <= 2 \[Pi], x]

(*
Out[131]= {{x -> 0}, {x -> \[Pi]/2}, {x -> \[Pi]}, {x -> (3 \[Pi])/2}, {x -> 
   2 \[Pi]}, {x -> 
   2 \[Pi] - 
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 1]]]}, {x ->
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 1]]]}, {x ->
    2 \[Pi] - 
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 2]]]}, {x ->
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 2]]]}, {x ->
    2 \[Pi] - 
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 3]]]}, {x ->
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 3]]]}, {x ->
    2 \[Pi] - 
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 4]]]}, {x ->
    2 ArcTan[Sqrt[Root[5 - 76 #1 + 222 #1^2 - 76 #1^3 + 5 #1^4 &, 4]]]}}
*)

Length[sol]

(* Out[106]= 13 *)

Hence we have found 13 solutions. The first five are simple expressions. The others ones can be simplified, but I have found no dierect way of simplify the Root[] expressions.

But I discovered by accident that the following works out fine: solving eq without the interval restrictions, chosing the appropriate integer parameters C[i] and and imposing the interval restriction afterwards gives

sol1 = Solve[eq, x];
sol1x = Select[
  Union[x /. sol1 /. C[1] -> 0, x /. sol1 /. C[1] -> 1], 0 <= # <= 2 \[Pi] &]

(*
Out[171]= {0, \[Pi]/2, \[Pi], (3 \[Pi])/2, 
 2 \[Pi], \[Pi] - ArcTan[Sqrt[(6 - Sqrt[6])/(6 + Sqrt[6])]], 
 2 \[Pi] - ArcTan[Sqrt[(6 - Sqrt[6])/(6 + Sqrt[6])]], 
 ArcTan[Sqrt[(6 - Sqrt[6])/(6 + Sqrt[6])]], \[Pi] + 
  ArcTan[Sqrt[(6 - Sqrt[6])/(6 + Sqrt[6])]], \[Pi] - 
  ArcTan[Sqrt[(6 + Sqrt[6])/(6 - Sqrt[6])]], 
 2 \[Pi] - ArcTan[Sqrt[(6 + Sqrt[6])/(6 - Sqrt[6])]], 
 ArcTan[Sqrt[(6 + Sqrt[6])/(6 - Sqrt[6])]], \[Pi] + 
  ArcTan[Sqrt[(6 + Sqrt[6])/(6 - Sqrt[6])]]}
*)

We recover 13 Solutions which are now explicit expressions.

Length[sol1x]

(* Out[173]= 13 *)

All are in the requested interval

sol1x/(2 \[Pi]) // N

(*
Out[174]= {0., 0.25, 0.5, 0.75, 1., 0.408465, 0.908465, 0.0915349, 0.591535, 0.341535, 0.841535, 0.158465, 0.658465}
*)

Now here is the explicit solution of the problem: all extrema and their locations:

txfa = Table[{sol1x[[i]], fa[sol1x[[i]]]}, {i, 1, Length[sol1x]}] // Simplify

(*
Out[165]= {{0, 1}, {\[Pi]/2, 0}, {\[Pi], 1}, {(3 \[Pi])/2, 0}, {2 \[Pi], 
  1}, {\[Pi] - ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]], 
  1/12 (6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]])}, {2 \[Pi] - 
   ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]], 
  1/12 (6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]])}, {ArcTan[Sqrt[
   1/5 (7 - 2 Sqrt[6])]], 
  1/12 (6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]])}, {\[Pi] + 
   ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]], 
  1/12 (6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 - 2 Sqrt[6])]]])}, {\[Pi] - 
   ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]], -(1/
    12) (-6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]])}, {2 \[Pi] - 
   ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]], -(1/
    12) (-6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]])}, {ArcTan[Sqrt[
   1/5 (7 + 2 Sqrt[6])]], -(1/
    12) (-6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]])}, {\[Pi] + 
   ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]], -(1/
    12) (-6 + Sqrt[6]) (2 - 2 Cos[2 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]] + 
     Cos[4 ArcTan[Sqrt[1/5 (7 + 2 Sqrt[6])]]])}}
*)

txfa // N // Sort

(*
Out[175]= {{0., 1.}, {0.575131, 0.363917}, {0.995665, 0.636083}, {1.5708, 0.}, {2.14593, 0.636083}, {2.56646, 0.363917}, {3.14159, 1.}, {3.71672, 
  0.363917}, {4.13726, 0.636083}, {4.71239, 0.}, {5.28752, 
  0.636083}, {5.70805, 0.363917}, {6.28319, 1.}}
*)

Finally, let's have a look at the function and its extrema

p1 = Plot[fa[x], {x, 0, 2 \[Pi]}];
p2 = ListPlot[txfa, PlotStyle -> {RGBColor[1, 0, 0], PointSize[0.02]}];

Show[p1, p2]
(* 150917_Plot_Extrema.jpg *)

enter image description here

$\endgroup$
6
  • $\begingroup$ Nicely done, as usual... +1 $\endgroup$ – ciao Sep 17 '15 at 10:53
  • $\begingroup$ @Dr.Wolfgang Hintze, Besides so much thanks, I think you mean of tt as txfa//N! because it is not defined before plot. Also can you translate a bit little this line: Select[ Union[x /. sol1 /. C[1] -> 0, x /. sol1 /. C[1] -> 1], 0 <= # <= 2 [Pi] &]. $\endgroup$ – Unbelievable Sep 17 '15 at 12:51
  • $\begingroup$ @ mr.0093: thank you for pointing out the tt->txfa error. It is correct now. As for the stuff with Union and C[i], please do the steps I have described in the text. You will easily find out how it works. If not, please tell me. $\endgroup$ – Dr. Wolfgang Hintze Sep 17 '15 at 13:07
  • $\begingroup$ I think this line essential because of existing ArcTan and some functions same as that, because each theta+2pi or something else theta+pi can be a solution, you check that it was in [0,2pi], but I find a problem that this doesn't work correctly and a correct answer goes away, If fa[x]=1 + 3 Cos[2 x]) Sin[2 x], you can see this method removes x -> 5.32787 and t -> 6.28319 (that is 2pi itself)!!!! $\endgroup$ – Unbelievable Sep 17 '15 at 19:11
  • $\begingroup$ @ mr.0093 the constants C[i] are arbitrariy within the domain of integers - as Solve tells you. So, in order to confine your solution to a certain interval, you have to fix them properly. This can be done one by one by hand or, as I did here, as a suitable collection put together with Union[]. $\endgroup$ – Dr. Wolfgang Hintze Sep 17 '15 at 20:49
5
$\begingroup$

I sometimes have a similar problem and a rather "rough" workaround. First make a plot of the function - omitting the output:

p = Plot[Norm@f[x], {x, 0, 2 \[Pi]}];

then extract the line segments

data = Cases[p, Line[{x__}] :> x, \[Infinity]];

then find the peaks

max = FindPeaks[#[[2]] & /@ data]

finally plot the result(s):

Show[p, Epilog -> {Red, PointSize[0.02], Point[data[[First /@ max]]]}]

O.K. a bit "brute force" and not so elegant, but working. You´ll get this plot and can process the data further on. Plot of norm with maxima

$\endgroup$
3
  • $\begingroup$ @ mgamer : very elegant. I recently did something similar (i.e. going into the structure of the output of Plot[]) when trying to find find jumps in a given function. $\endgroup$ – Dr. Wolfgang Hintze Sep 17 '15 at 12:12
  • $\begingroup$ @mgamer, How can I determine the minimums, because I could not find a function same as FindPeaks for minimums! $\endgroup$ – Unbelievable Sep 17 '15 at 12:36
  • $\begingroup$ @mr.0093: Just like in optimization take the max of -f :-) $\endgroup$ – mgamer Sep 17 '15 at 14:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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