0
$\begingroup$

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]

enter image description here

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?

$\endgroup$
2
$\begingroup$

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

enter image description here

$\endgroup$
2
  • $\begingroup$ thank you very much! one minor thing: I think you forgot the 'sorted=' in front of the 'Sort[data]'. With that it works perfectly! $\endgroup$ – Luke Mar 18 '20 at 17:17
  • $\begingroup$ Great, deleted while copying it. $\endgroup$ – Rupesh Mar 18 '20 at 17:25

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.