Determining the local extrema of discrete data [duplicate]

Question

Possible Duplicate:
Local max/min of Mathematica data sets

If I have a continuous function f (for example f = Sin[x]), I can find the local extrema in the vicinity of $x = x_0$ using FindMinimum[f, {x, x0}] and FindMaximum[f, {x, x0}]. For example:

FindMinimum[Sin[x], {x, Pi}]
FindMaximum[Sin[x], {x, Pi}]

(* {-1., {x -> 4.71239}} *)
(* {1., {x -> 1.5708}} *)

However, what if I have a discrete function -- a function described by a list of points? This comes up frequently when working with data from experiments. For example, suppose I have the following discrete function described by x and f:

x = Range[0, 2 Pi, 0.1];
f = Sin[x];
Show[{
  Plot[Sin[x], {x, 0, 2 Pi}, PlotRange -> All],
  ListPlot[Transpose[{x, f}]]

How can I find the local extrema of the data defined by Transpose[{x, f}]?

I could interpolate the data and then use FindMinimum and FindMaximum:

interp = Interpolation[Transpose[{x, f}]]
FindMinimum[interp[x], {x, Pi}]
FindMaximum[interp[x], {x, Pi}]

(* InterpolatingFunction[{{0., 6.2}}, <>] *)

(* {-0.999999, {{0., 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1., 
    1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2., 2.1, 2.2, 2.3, 
    2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3., 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 
    3.7, 3.8, 3.9, 4., 4.1, 4.2, 4.3, 4.4, 4.5, 4.6, 4.7, 4.8, 4.9, 
    5., 5.1, 5.2, 5.3, 5.4, 5.5, 5.6, 5.7, 5.8, 5.9, 6., 6.1, 6.2} -> 
   4.71232}} *)

(* {0.999998, {{0., 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1., 1.1,
     1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2., 2.1, 2.2, 2.3, 2.4, 
    2.5, 2.6, 2.7, 2.8, 2.9, 3., 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, 
    3.8, 3.9, 4., 4.1, 4.2, 4.3, 4.4, 4.5, 4.6, 4.7, 4.8, 4.9, 5., 
    5.1, 5.2, 5.3, 5.4, 5.5, 5.6, 5.7, 5.8, 5.9, 6., 6.1, 6.2} -> 
   1.57084}} *)

But is there any way to find the local extrema without using Interpolation? Thanks for your time.

Answer 1

Perhaps a combination of ListConvolve and Nearest would work. This allows you to create a sort of moving Map of any function you want including Min and Max.

movingMap[fn_, data_, w_] := 
 Nearest[Rule @@@ 
   Transpose[{Median /@ Partition[data[[All, 1]], w, 1], 
     ListConvolve[ConstantArray[1, w], data[[All, 2]], {-1, 1}, {}, 
      Times, fn[{##}] &]}]]

Here it is with Min and Maxusing a window width of 3.

Plot[{movingMap[Max, data, 3][t], movingMap[Min, data, 3][t]}, {t, 0, 
  6}, PlotPoints -> 250]

You can use more exotic functions. Here I'm using the .975 and .025 quantiles to get a 95% confidence estimate this time with a window width of 6.

Plot[{movingMap[Quantile[#, .975] &, data, 6][t], 
  movingMap[Quantile[#, .025] &, data, 6][t]}, {t, 0, 6}, 
 PlotPoints -> 250]

Note that I'm using Median on the moving Partition as locations in Nearest you may want to adjust this to be the first element of the window or some other number.

Answer 2

If your coordinates are the set of points $\{x,f\}$, then run a three-point median filterm=MedianFilter[f,1] and compare function values $f$ to filtered values $m$. The function $f$ has a local maximum at a point where $f>m$. A local minimum occurs where $f<m$. On slopes, the median equals the function value. Pick locations where the function value and its median are unequal, these are the extrema.

Answer 3

With some data:

data = Table[{x, Sin[x]}, {x, 0, 2 \[Pi], 0.1}]

You could partition it into triplets, then pick out which ones have the higher middle point:

Cases[Partition[data, 3, 1], {{_, a_}, p : {_, b_}, {_, c_}} /; a < b && c < b -> p]

{{1.6, 0.999574}}

You can easily adjust the condition to pick out minima.

Be warned though, that this does only what it says: pick out a point from your data that is strictly higher that its neighbours. It's not going to work with plateaux. And with experimental data, you might have to deal with noise and error which could give you hundreds of local maxima.