Here's an adaptation of the NDSolve
method used by Daniel Lichtblau that uses numeric (finite difference) derivatives. Just what to return and in what form is a choice. The following returns a list of FindMinimum
style solutions {{m1, {x -> x1}}, {m2, {x -> x2}},...}
. The solutions may be polished further with FindMinimum
.
findAllMinima[f_, {x_, x1_, x2_}, opts : OptionsPattern[NDSolve]] :=
Module[{nf, res, xx, df, y},
nf = Experimental`CreateNumericalFunction[{x}, {f}, {1}, Jacobian -> FiniteDifference];
df[x0_?NumericQ] := nf["Jacobian"[{x0}]][[1, 1]];
res = Reap[NDSolve[
{y'[xx] == df[xx], y[x1] == First@nf[{x1}],
WhenEvent[y'[xx] > 0, Sow[{y[xx], {x -> xx}}]]},
y, {xx, x1, x2}, opts]][[2, 1]]
];
Sample numeric functions (InterpolatingFunctions
) obtained by integrating a slightly noisy, oscillatory function:
SeedRandom[1];
xdata = Sort@ DeleteDuplicates[Join[{0., 100.}, RandomReal[{0, 100}, 1000]],
Chop@Subtract[##] == 0 &];
ydata = xdata^2 (Sin[xdata] + Cos[3 xdata]) + 10 RandomReal[{-1, 1}, Length@xdata];
g0 = Interpolation[Transpose[{Sqrt[xdata], ydata}], InterpolationOrder -> 1];
g = NestList[Integrate[#, t] &, g0[t], 3]; (* four functions, increasing differentiable *)
We'll use the last two, which are relatively smooth (see plots below), and we'll wrap the functions in a NumericQ
-protected black-box (just in case).
ng[t_?NumericQ] = g[[3]];
findAllMinima[ng[t], {t, 0, 10}]
(*
{{-1.19007, {t -> 1.35809}}, {-5.11378, {t -> 2.84282}}, {-9.42955, {t -> 3.79441}},
{-12.3119, {t -> 4.5406}}, {-13.9851, {t -> 5.18681}}, {-13.762, {t -> 5.75923}},
{-10.335, {t -> 6.27529}}, {-1.29706, {t -> 6.759}}, {-1.39131, {t -> 7.21652}},
{-4.57187, {t -> 7.63862}}, {-5.02481, {t -> 8.03896}}, {-4.8891, {t -> 8.41996}},
{-2.75207, {t -> 8.78808}}, {-22.9376, {t -> 9.1421}}, {-39.9945, {t -> 9.47799}},
{-54.2516, {t -> 9.80125}}}
*)
Probably, one should set the PrecisionGoal
smaller by default, as it is quite a bit faster. And it is still accurate on this example.
findAllMinima[ng[t], {t, 0, 10}]; // AbsoluteTiming
findAllMinima[ng[t], {t, 0, 10}, PrecisionGoal -> 3]; // AbsoluteTiming
(*
{1.31999, Null}
{0.056883, Null}
*)
Examples:
ng[t_?NumericQ] = g[[4]];
mins = findAllMinima[ng[t], {t, 0, 10}, PrecisionGoal -> 3];
Plot[g[[3]], {t, 0, 10},
Epilog -> {PointSize[Medium], Red,
Point[Transpose[{t /. mins[[All, 2]], mins[[All, 1]]}]]},
PlotPoints -> 201, PlotRange -> All]

ng[t_?NumericQ] = g[[4]];
mins = findAllMinima[ng[t], {t, 0, 10}, PrecisionGoal -> 3];
Plot[g[[4]], {t, 0, 10},
Epilog -> {PointSize[Medium], Red,
Point[Transpose[{t /. mins[[All, 2]], mins[[All, 1]]}]]},
PlotPoints -> 201, PlotRange -> All]

NDSolve
in the linked thread? $\endgroup$ – Oleksandr R. Aug 31 '15 at 16:48Plot
is supposed to be for plotting, and using it to find minima seems wrong." - old military maxim: "if it's dumb and it works, it ain't dumb". I happen to think making a preliminary plot is very useful for localizing extrema and roots. Otherwise,FindMinimum[]
has methods for finding minima that don't need derivative evaluations; search the docs. $\endgroup$ – J. M.'s ennui♦ Aug 31 '15 at 17:14Plot[]
; use it to get starting points, and then useFindMinimum[]
for polishing. $\endgroup$ – J. M.'s ennui♦ Aug 31 '15 at 17:49