0
$\begingroup$

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.

$\endgroup$
1
  • $\begingroup$ Maybe you can find peak in your original NDSolve directly. $\endgroup$
    – cvgmt
    Jan 21, 2022 at 0:54

1 Answer 1

2
$\begingroup$

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

enter image description here

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

enter image description here

$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$
    – Albert
    Jan 20, 2022 at 21:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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