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[1]:= 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[2]:= sol = First[NDSolve[{y''[x] == -y[x], y[0] == 1, y'[0] == 0},
y,
{x, -6, 6}]];
In[3]:= Plot[y[x] /. sol, {x, -6, 6}];
Here we find the minima and maxima over (-6,6):
In[4]:= Delta[y[x] /. sol, {x, -6, 6}]
Out[4]= {-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[5]:= Needs["Utilities`FilterOptions`"]
In[6]:= 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[7]:= {x, y[x]} /. RootsInRange[y'[x] /. sol, {x, -6, 6}] /. sol //
Chop
Out[7]= {{-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
____________________________________________________________________