1
$\begingroup$

This question (and the first answer in particular), teaches us how to find all the local maxima and minima of a function.

My question is: how can I separate the maxima from the minima? My goal is to find the curve that fits all the local maxima

Using the code from the cited answer:

GetRLine3[MMStdata_, IO_: 1][x_: x] := 
  ListInterpolation[#, InterpolationOrder -> IO, Method -> "Spline"][
     x] & /@ (({{#[[1]]}, #[[2]]}) & /@ # & /@ MMStdata);
data = Transpose[{# + RandomReal[]*0.1 & /@ Range[-10, 30, 0.4], 
    Tanh[#] + (Sech[2 x - 0.5]/1.5 + 1.5) /. x -> # & /@ 
     Range[-4, 4, 0.08]}];

xLimits = {Min@#1, Max@#1} & @@ Transpose[data];
f = First[100*D[GetRLine3[{data}, 3][x], x]];

vals = Reap[
    soln = y[x] /. 
      First[NDSolve[{y'[x] == Evaluate[D[f, x]], 
         y[-9.9] == (f /. x -> -9.9)}, y[x], {x, -9.9, 30}, 
        Method -> {"EventLocator", "Event" -> y'[x], 
          "EventAction" :> Sow[{x, y[x]}]}]]][[2, 1]];

I tried to modify it using WhenEvent, instead:

vals = Reap[
    soln = y[x] /. 
      First[NDSolve[y'[x] == Evaluate[D[f, x]], y[-9.9] == (f /. x -> -9.9),
         WhenEvent[y'[x] == 0 && y''[x] <= 0, Sow[{x, y[x]}], 
         y[x], {x, -9.9,30}]]]][[2, 1]];

I used it because I need the maxima, therefore the point with a negative second derivative, but I only get a long sequence of errors.

$\endgroup$
  • $\begingroup$ Is it better now @MarcoB? $\endgroup$ – mattiav27 Apr 3 at 14:44
  • $\begingroup$ Much better. Thank you! I reverted my downvote. $\endgroup$ – MarcoB Apr 3 at 15:06
1
$\begingroup$

The event y'[x] < 0 is what you want to look for, since at a maximum the slope goes from positive to negative. So, correcting some syntax errors and using the suggested event gives:

max = Reap[
    NDSolve[
        {
        y'[x] == D[f,x],
        y[-9.9]==(f/.x->-9.9),
        WhenEvent[y'[x]<0,Sow[{x,y[x]}]]
        },
        y[x],
        {x,-9.9,30}
    ]
][[2, 1]]

{{-8.86017, 0.0621429}, {-8.0376, 0.0738668}, {-7.24695, 0.118799}, {-6.565, 0.17745}, {-5.67063, 0.256033}, {-4.82042, 0.285138}, {-4.01709, 0.417515}, {-3.25848, 0.57663}, {-1.67717, 1.14838}, {-0.473554, 1.90089}, {0.255471, 2.30037}, {1.12508, 3.47191}, {2.27665, 5.53463}, {3.20095, 7.50788}, {4.65821, 13.0315}, {5.47844, 14.8531}, {6.28744, 20.8996}, {7.20715, 28.8187}, {8.27185, 37.4885}, {9.29902, 31.5518}, {10.2004, 33.2045}, {11.0185, 25.9951}, {14.0835, -1.66968}, {15.39, -1.58448}, {16.4007, -1.11386}, {18.3452, -0.35453}, {19.1145, -0.297394}, {19.9694, -0.13902}, {21.1993, -0.116217}, {22.026, -0.0657477}, {23.8522, -0.0300916}, {25.6248, -0.0160541}, {26.6953, -0.0104677}, {27.5689, -0.00694611}, {29.1361, -0.00292188}}

Visualization:

Plot[f, {x, -9.9, 30}, Epilog -> {PointSize[Large], Red, Point[max]}]

enter image description here

$\endgroup$

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.