# Plot maximum value of a function of three variables

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$$.

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

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


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
]


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


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.

• 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. – Ulrich Neumann Apr 30 '19 at 7:18
• @UlrichNeumann Ah, I guess I misunderstood the question. – MassDefect Apr 30 '19 at 15:34
• @ MassDefect But you gave an interesting solution approach!!! – Ulrich Neumann Apr 30 '19 at 20:26

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