Re: Maxima & Minima
- To: mathgroup at smc.vnet.net
- Subject: [mg53732] Re: [mg53703] Maxima & Minima
- From: DrBob <drbob at bigfoot.com>
- Date: Tue, 25 Jan 2005 05:03:41 -0500 (EST)
- References: <200501240837.DAA28176@smc.vnet.net>
- Reply-to: drbob at bigfoot.com
- Sender: owner-wri-mathgroup at wolfram.com
Here's a complete list of local extrema in the raw data:
data[[1+Flatten@Position[Partition[data[[All, 2]], 3, 1], {a_, b_,
c_} /; b < Min[a, c] || b > Max[a, c]]]]
{{0.51, 1.30244},
{0.53, 1.3059},
{0.54, 1.30544},
{0.58, 1.31146},
{0.59, 1.31105},
{0.66, 1.32175},
{0.67, 1.32041},
{0.83, 1.81008},
{1.11, 0.0324386},
{1.71, 1.72145}}
(Too many, if we assume the data is only approximate.)
Here's another method:
{min, max} = Through[{Min, Max}@data[[All, 1]]];
f = Interpolation[data];
Plot[{f@x, f'@x}, {x, min, max}]
Off[InterpolatingFunction::"dmval"]
FindRoot[f'[x] == 0, {x, #}] & /@ {min, 1, 2}
{{x -> 0.505531}, {x -> 1.12307}, {x -> 1.7219}}
{x, f@x} /. %
{{0.5055312156861533, 1.301922579278834},
{1.1230689459629595, 0.027059539216569332},
{1.7218962023425761, 1.721953518594516}}
(That misses the first maximum rather badly.)
And a third method:
<<NumericalMath`InterpolateRoot`
InterpolateRoot[f'@x == 0, {x, min, 1}]
InterpolateRoot[f'@x == 0, {x, 1, 1.5}]
InterpolateRoot[f'@x == 0, {x, 1.5, max}]
{x -> 0.52857394991751015071728945637877314465`23.723105755682077}
{x -> 1.72189620234257605782273932854817383567`22.23600696819283}
{x -> 5.09205275261335446811354032880462993659`22.706892894205932}
(That misses both maxima.)
So all three methods have their problems, obviously.
Finally, here's a modification of the first method, in which I rely on the ListPlot to suggest there should be two maxima and one minimum, and select (in an admittedly primitive sense) the most prominent features that qualify. The idea is to ignore tiny peaks and valleys the first method zooms in on.
First the minimum:
delta1 = Max@
Cases[Partition[data[[All, 2]], 3, 1], {a_,
b_, c_} /; b < Min[a, c] :> Min[a, c] - b];
data[[1 + Flatten@Position[Partition[data[[All, 2]], 3, 1], {a_, b_,
c_} /; b â?¤ Min[a, c] - delta1]]]
{{1.11, 0.0324386}}
And the maxima:
delta2 = Sort[
Cases[Partition[data[[All,
2]], 3, 1], {a_, b_, c_} /; b > Max[a, c] :> b - Max[a,
c]]][[-2]];
data[[1 + Flatten@Position[Partition[data[[All, 2]], 3, 1], {
a_, b_, c_} /; b â?¥ Max[a, c] + delta2]]]
{{0.83, 1.81008},
{1.71, 1.72145}}
All in all, that looks like the best answer of the four.
Analysis of this kind with a finite sample is always iffy, of course.
Bobby
On Mon, 24 Jan 2005 03:37:24 -0500 (EST), nilaakash <nilaakash at gmail.com> wrote:
> Dear Friends,
> Suppose I have some points. If you plot these points
> you will see there are few maxima and minima. I want to find only
> those maxima and minima points. Is there any process to findout only
> those max & min coordinates. (both x & y points).
>
> data={{0.5, 1.30301}, {0.51, 1.30244}, {0.52, 1.30533}, {0.53,
> 1.3059}, {0.54,
> 1.30544}, {0.55, 1.30816}, {0.56, 1.30942}, {0.57, 1.30952},
> {0.58,
> 1.31146}, {0.59, 1.31105}, {0.6, 1.31357}, {0.61, 1.31614}, {0.62,
> 1.31636}, {0.63, 1.31782}, {0.64, 1.31977}, {0.65, 1.31993},
> {0.66,
> 1.32175}, {0.67, 1.32041}, {0.68, 1.32705}, {0.69, 1.33001}, {0.7,
> 1.33689}, {0.71, 1.34665}, {0.72, 1.35868}, {0.73, 1.37899},
> {0.74,
> 1.40351}, {0.75, 1.44677}, {0.76, 1.49938}, {0.77, 1.56417},
> {0.78,
> 1.6265}, {0.79, 1.68231}, {0.8, 1.73439}, {0.81, 1.77567}, {0.82,
> 1.79751}, {0.83, 1.81008}, {0.84, 1.80272}, {0.85, 1.78359},
> {0.86,
> 1.74827}, {0.87, 1.69779}, {0.88, 1.63964}, {0.89, 1.57302}, {0.9,
> 1.49157}, {0.91, 1.40873}, {0.92, 1.32168}, {0.93, 1.22632},
> {0.94,
> 1.12993}, {0.95, 1.03509}, {0.96, 0.940307}, {0.97, 0.843889},
> {0.98,
> 0.750626}, {0.99, 0.658783}, {1., 0.571786}, {1.01, 0.490484},
> {1.02,
> 0.414139}, {1.03, 0.342955}, {1.04, 0.27755}, {1.05, 0.219544},
> {1.06,
> 0.169213}, {1.07, 0.126781}, {1.08, 0.091582}, {1.09, 0.0642237},
> {1.1,
> 0.0444826}, {1.11, 0.0324386}, {1.21, 0.17094}, {1.31, 0.721742},
> {1.41,
> 1.17931}, {1.51, 1.49921}, {1.61, 1.67064}, {1.71, 1.72145},
> {1.81,
> 1.69853}, {1.91, 1.6343}, {2.01, 1.54399}, {2.11, 1.45614}, {2.21,
> 1.36254}, {2.31, 1.27609}, {2.41, 1.19319}, {2.51, 1.12123},
> {2.61,
> 1.04736}, {2.71, 0.98465}, {2.81, 0.925526}, {2.91, 0.871404},
> {3.01,
> 0.821615}, {3.11, 0.77698}, {3.21, 0.732385}, {3.31, 0.693622},
> {3.41,
> 0.655827}, {3.51, 0.623108}, {3.61, 0.591913}, {3.71, 0.562528},
> {3.81,
> 0.534357}, {3.91, 0.50876}, {4.01, 0.484918}, {4.11, 0.463476},
> {4.21,
> 0.441866}, {4.31, 0.422324}, {4.41, 0.4049}, {4.51, 0.387806},
> {4.61,
> 0.371429}, {4.71, 0.356785}, {4.81, 0.3418}, {4.91, 0.328734}}
>
> Thanks
>
> nilaakash
>
>
>
>
--
DrBob at bigfoot.com
www.eclecticdreams.net
- References:
- Maxima & Minima
- From: nilaakash@gmail.com (nilaakash)
- Maxima & Minima