# How to plot the peak of a wavefunction depending on time

I am trying to define a function to find the spatial peak of some interpolation function of two variables (one spatial variable and one temporal variable) which is the output of NDSolve. In order to keep this question simple, let me use this Interpolation function instead:

list = Flatten[Table[{x, t, Cos[x + t]}, {x, 0, 10}, {t, 0, 10}], 1];
prob = Interpolation[list]



I tried the following:

peak[t_?NumericQ, func_] :=
x /. Last[NMaximize[{func[x, t], 0 < x < 10}, x]]


where func_ stands for the interpolation function for which I want to find the peak and x and t are the spatial and temporal variables, respectively. I try to plot that for the interpolating function prob[x,t]:

Plot[peak[t, prob], {t, 0, 10}]


However, the output appears after a long time. Is there a way to optimize that? Can I define the function of the peak differently in order to get a faster plot?

Thank you all in advance.

• Maybe you can find peak in your original NDSolve directly. Jan 21, 2022 at 0:54

Looking at your function it is obvious that it does not have an unique maximum. "prob" has a maximum along the lines: x+t == 2 n Pi where n is an integer.

Therefore, for an example, I choose a function with an unique maximum:

list = Flatten[
Table[{x, t, Exp[-(x - 5)^2 - (t - 5)^2]}, {x, 0, 10}, {t, 0, 10}],
1];
prob = Interpolation[list]
sol = NMaximize[{prob[x, t], 0 < x < 5, 0 <= t <= 5}, {x, t}]
Show[{Plot3D[prob[x, t], {x, 0, 10}, {t, 0, 10}, PlotRange -> All],
Graphics3D[{PointSize[Large], Black,
Point[{x, t, sol[[1]]} /. sol[[2]]]}]}]


Update

To get the maximum as a function of time we may define the function "max[t]". As "max" is time consuming I make an example with "Manipulate" and draw only one point as a function of time:

list = Flatten[
Table[{x, t, Exp[-0.1 (x - 5)^2 - 0.1 (t - 5)^2]}, {x, 0, 10}, {t,
0, 10}], 1];
prob = Interpolation[list]
sol[t_] := NMaximize[{prob[x, t], 0 < x < 10}, x][[2]];
max[t_] := {x /. sol[t], t, prob[x /. sol[t], t]}

Manipulate[
Show[{ListPlot3D[list, PlotRange -> All],
ParametricPlot3D[{x, t, prob[x, t]}, {x, 0, 10}],
Graphics3D[{PointSize[0.04], Point[max[t]]}]
}]
, {t, 0, 10}]


• Thank you! That's right, I didn't notice that. My trouble is, however, that I want a function that describes which is the position of the peak at each instant of time. I'm searching for something like peak[t], that I could apply to different functions function[x,t] and then plot the value of the peak for each time instant. Jan 20, 2022 at 21:46