       Re: Minima

• To: mathgroup at smc.vnet.net
• Subject: [mg7995] Re: Minima
• From: Paul Abbott <paul at physics.uwa.edu.au>
• Date: Wed, 30 Jul 1997 23:57:48 -0400
• Organization: University of Western Australia
• Sender: owner-wri-mathgroup at wolfram.com

```Bernhard Petri wrote:

> Is there a way to determin several (best all) minima and/or maxima of a
> interpolating function optained with ndsolve?

There is only *one* maxima or minima.  Do you mean all local maxima and
minima?

Code for finding the extrema of functions over a domain using Plot and
Cases
was presented in "Maxima and minima over an interval," in The
Mathematica Journal 6(4): 26, 1996.  It also works with interpolating
functions:

In:= Delta[f_, {x_, a_, b_}] := Module[{y}, y =
Last[Transpose[Cases[Plot[f, {x, a, b},
PlotRange -> All, DisplayFunction -> Identity],
_Line, Infinity][[1,1]]]]; {Min[y], Max[y]}]

In:= sol = First[NDSolve[{y''[x] == -y[x], y == 1, y' == 0},
y,
{x, -6, 6}]];

In:= Plot[y[x] /. sol, {x, -6, 6}];

Here we find the minima and maxima over (-6,6):

In:= Delta[y[x] /. sol, {x, -6, 6}]
Out= {-0.99999, 0.999987}

In the forthcoming issue of the Mathematica Journal, there is code for
finding roots of a function over a domain.  Applying this to the
derivative of a function yields the extrema:

In:= Needs["Utilities`FilterOptions`"]

In:= RootsInRange[d_, {l_, lmin_, lmax_},
opts___] := Module[{s, p, x,
f = Function[l, Evaluate[d]]},
s = Plot[f[l], {l, lmin, lmax},
Compiled -> False, Evaluate[FilterOptions[Plot, opts]]];
p = Cases[s, Line[{x__}] -> x, Infinity];
p = Map[First, Select[Split[p,
Sign[Last[#2]] == -Sign[Last[#1]] & ], Length[#1] == 2 & ],
{2}];
Apply[FindRoot[f[l] == 0, {l, ##1},
Evaluate[FilterOptions[FindRoot, opts]]] & , p, {1}]]

For example:

In:= {x, y[x]} /. RootsInRange[y'[x] /. sol, {x, -6, 6}] /. sol //
Chop
Out= {{-3.14159, -0.99999}, {0, 1.}, {3.14159, -0.99999}}

Cheers,
Paul

____________________________________________________________________
Paul Abbott                                   Phone: +61-8-9380-2734
Department of Physics                           Fax: +61-8-9380-1014
The University of Western Australia
Nedlands WA  6907                     mailto:paul at physics.uwa.edu.au
AUSTRALIA                              http://www.pd.uwa.edu.au/Paul

God IS a weakly left-handed dice player
____________________________________________________________________

```

• Prev by Date: Comparison of Mathematica on Various Computers
• Next by Date: Re: How do I read/write binary image data? (fwd)
• Previous by thread: Re: Minima
• Next by thread: Help needed!