Find the two largest maximums of an interpolating function of a specific shape (fast)

Question

I have an oscillating interpolating function f[x] and I would like to find the x values of the two largest maximums (or even better: their distance).

One example of such an interpolating function is generated by this code:

v0 = 2 10^-5;
h = 1/50; 
a = -10; 
b = 10; 
plist = Range[N@a, b, h]; 
\[Psi]pi = E^(-(p^2/4)) (2/\[Pi])^(1/4) /. p -> plist;
ham = With[{c = N[I v0/(8 h^3)]}, 
   SparseArray[{Band[{1, 1}] -> 1./4 plist^2 + 0. I, 
     Band[{1, 4}] -> c, Band[{1, 3}] -> -8 c, Band[{1, 2}] -> +13 c, 
     Band[{2, 1}] -> -13 c, Band[{3, 1}] -> +8 c, 
     Band[{4, 1}] -> -c}, {1, 1} Length[plist], 0. + 0. I]];
\[Psi]p[t_, \[Psi]p0_] := \[Psi]p[t, \[Psi]p0] = 
   MatrixExp[ham/I (2. Pi t), \[Psi]p0]; 
f[t_] := f[t] = 
  Interpolation[Transpose[{plist, Abs[\[Psi]p[t, \[Psi]pi]]^2}]]
Plot[f[10][x], {x, -5, 5}, PlotRange -> All, PlotStyle -> Blue]

I do not know in advance where this function is located, meaning it could be shifted by some unknown value in positive or negative x direction. However, I do know that this interpolating function always has this triangular shape, such that the largest maximum is on the right and the second largest maximum is the next one going to the left. In the end I would like to plot the distance of these maximums for different values of t. For small t there exists only one maximum and it would be nice if the code returns the value 0 in this case.

I tried things like

NSolve[D[f[10][x], x] == 0, x]

and played around with FindRoot and FindMaximum but these approaches weren't very successful. Is there an elegant and fast way of doing this?

Answer 1

As far as I understand you want to find x-coordinates of the two maximum peak values. I guess using FindPeaks can be useful in this case:

    d = Table[{x, f[10][x]}, {x, -5, 5, .01}];
    Fp = FindPeaks[d[[All, 2]]]
    data1 = Map[{d[[All, 1]][[#[[1]]]], #[[2]]} &, Fp];

Now, just sort it

    sorted=Sort[data1, Last[#2] < Last[#1] &];

    cords = sorted[[1 ;; 2]];
    tex = cords;
    offset = Map[# + {1.9, 0} &, cords];
    ListLinePlot[d, Joined -> {True, False}, PlotStyle -> {Blue}, 
    PlotRange -> All, 
    Epilog -> {Thread[Text[tex, offset]], Red, PointSize[0.02], 
    Point[cords]}, BaseStyle -> {FontSize -> 14}]