1
$\begingroup$

Given a function f[\[Theta]_, \[Phi]_, t_] given by

f[θ_, ϕ_, t_] = 
  Cos[θ]^2 Sin[t] + 
   Exp[-I ϕ] Sin[θ] Exp[-t] Sin[3 t]^2;
Plot[f[π/2, 0, t], {t, 0, 10}, PlotRange -> All]

Here, $0 \le \theta \le \pi/2$ and $0 \le \phi \le 2 \pi$. I want a plot of $|f[\theta_0, \phi_0, t]|$ with respect to $t$ such that $\theta_0$ and $\phi_0$ make the absolute value $|f[\theta_0, \phi_0, t]|$ maximum at that time.

Edit1: Since the function is complex. It would be necessary to talk about absolute value. I have made an edit in the question.

Edit2: I want to make my question little more precise. At every point of time say $t_1$, I want Mathematica to search over the entire allowed range of $\theta$ and $\phi$ and choose the maximum value of $|f(\theta, \phi, t_1)|$ at that time. Similarly for next time $t_2 > t_1$. Next, I need to plot those maximum values with respect to the time $t$.

$\endgroup$
  • $\begingroup$ Is your function complex? If so, what do you mean by ""maximum"? $\endgroup$ – mikado Apr 30 at 5:45
  • $\begingroup$ @mikado, thanks for pointing out. I have made an edit. $\endgroup$ – H. Kenan Apr 30 at 6:06
4
$\begingroup$

I might be misinterpreting the question, but it seems like the OP is asking for a 2-D representation (t vs. the maximum of f over the whole domain).

nmax[t_] := NMaxValue[{
   Abs[f[θ, ϕ, t]], 
   0 <= θ <= π/2 && 0 <= ϕ <= 2 π}, 
   {θ, ϕ}]

Plot[nmax[t], {t, 1, 10}, AxesOrigin -> {1, 0}]

enter image description here

$\endgroup$
2
$\begingroup$

Since you want to plot 3 variables and a value, we need some kind of 4D plotting scheme like DensityPlot3D.

f[θ_, ϕ_, t_] := Cos[θ]^2*Sin[t] + Exp[(-I)*ϕ]*Sin[θ]*Exp[-t]*Sin[3*t]^2

DensityPlot3D[
 Abs[f[θ, ϕ, t]],
 {θ, 0, π/2},
 {ϕ, 0, 2 π},
 {t, 0, 10},
 AxesLabel -> {"θ", "ϕ", "t"},
 OpacityFunction -> (# &),
 PlotLegends -> Automatic
]

Density plot of 4D function.

I've rotated the graph a bit to better see where the function is maximized, and adjusted the opacity function a bit, although that wasn't totally necessary. It seems like $\phi$ has essentially no effect on the result. My next thought was to use Plot3D to look at it while ignoring $\phi$ (I'll show that graph at the end).

Plot3D wasn't totally necessary, but it does help me get a feel for what the function is doing in a graph that's a little easier for my mind to comprehend. I found the maximum:

{val, params} = 
 FindMaximum[{Abs[f[θ, ϕ, t]], 0 <= θ <= π/2, 
   0 <= ϕ <= 2 π, 0 <= t <= 10}, {θ, ϕ, t}]

and then used this to plot a point on the Plot3D that indicates where the maximum is. This is nice because I can rotate the graph around and see whether I believe it or not.

Show[
 Plot3D[
  Abs[f[θ, 0, t]],
  {θ, 0, π/2},
  {t, 0, 10},
  AxesLabel -> {"θ", "t", "f"},
  PlotPoints -> 200
  ],
 Graphics3D[{
   AbsolutePointSize[10],
   Point[{θ, t, val} /. params]
   }]
 ]

Plot3D of the function ignoring phi.

Once you run the code, you can rotate the Plot3D and see if you believe the result. Of course, I've ignored $\phi$ for the purposes of this final plot because it didn't look to my eye like it had much effect, but the FindMaximum algorithm does take it into account. Over a constrained area that doesn't appear to have any super unusual features, I expect that FindMaximum should do a very good job of finding the true global maximum.

$\endgroup$
  • $\begingroup$ I don't think that it is a 4D-problem. For given t there is a maximum {\[Theta][t], \[Phi][t], t} which can be plotted in 3D. $\endgroup$ – Ulrich Neumann Apr 30 at 7:18
  • $\begingroup$ @UlrichNeumann Ah, I guess I misunderstood the question. $\endgroup$ – MassDefect Apr 30 at 15:34
  • $\begingroup$ @ MassDefect But you gave an interesting solution approach!!! $\endgroup$ – Ulrich Neumann Apr 30 at 20:26
1
$\begingroup$

Try

max[t_] := {\[Theta], \[Phi], t} /. NMaximize [{Conjugate[f[\[Theta], \[Phi], t]] f[\[Theta], \[Phi], t], 0 < \[Theta] < Pi/2, 0 < \[Phi] < 2 Pi}, {\[Theta], \[Phi]}][[2]]

to find the maximum {\[Theta][t], \[Phi][t], t} for given t:

max[1]
(* {0.135214, 1.79353, 1} *)

I don't know why ParametricPlot3D[Evaluate[max[t]], {t, 0, 1}] doesn't work, but you can plot the maxima as follows

pt = Table[max[t], {t, 0, 10, .1}];
Graphics3D[{Point[pt]}, BoxRatios -> {Pi/2, 2 Pi, 10}]  

enter image description here

$\endgroup$

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.