MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Time series minima and maxima

Some follow up that I hope spurs additional discussion.

Get and format some data:

data = FinancialData["SPY", {"May 1, 2006", "Jan. 21, 2011"}][[All,
data = data/First@data;
data = Transpose[{Range[Length@data], data}];

Define 2 functions:

First Ray's method (I think I've got the typos fixed this time):

findMinimaMaxima[data_, window_] := With[{k = window},
  data[[k + Flatten@Position[Partition[data[[All, 2]], 2 k + 1, 1],
x_List /;  x[[k + 1]] < Min[Delete[x, k + 1]] || x[[k + 1]] >
Max[Delete[x, k + 1]]]]]]

Now another approach, although not as flexible:

findMinimaMaxima2[data_] := data[[Accumulate@(Length[#] & /@
Split[Prepend[Sign[Rest@data[[All, 2]] - Most@data[[All, 2]]], 0]])]]

Look at what each the functions does.  First findMinimaMaxima2[]:

minmax = findMinimaMaxima2[data];
{Length@data, Length@minmax}

This selects all minima and maxima and results (in this instance) in
about a 49% data compression, but it doesn't have the flexibility of
expanding the window.
Ray's method, with a window of 2, yields fewer and arguably more
important extrema:

minmax2 = findMinimaMaxima[data, 2];
{Length@data, Length@minmax2}

But look at what happens when we expand the window to 60:

minmax2 = findMinimaMaxima[data, 60];
ListLinePlot[{data, minmax2}]

Some of the minima and maxima no longer alternate.
Applying findMinimaMaxima2[] to the output of findMinimaMaxima[] gives
a workaround...

minmax3 = findMinimaMaxima2[minmax2];
ListLinePlot[{data, minmax2, minmax3}]

But this seems like a clumsy way to address the problem.

So, the idea of using a fixed window to look left and right doesn't
quite do everything one would like.  I began thinking about an
alternative that could use a range value R (e.g. a percent move up or
down) that the function would need to meet or exceed to set the next
minima or maxima.  Here's my first try:

findMinimaMaxima3[data_, R_] := Module[{d, n, positions},
  d = data[[All, 2]];
  n = Transpose[{data[[All, 1]], Rest@FoldList[If[(#2 <= #1 + #1*R &&
#2 >= #1) || (#2 >= #1 - #1* R && #2 <= #1), #1, #2] &, d[[1]], d]}];
  n = Sign[Rest@n[[All, 2]] - Most@n[[All, 2]]];
  positions = Flatten@Rest[Most[Position[n, Except[0]]]];

minmax4 = findMinimaMaxima3[data, 0.1];
ListLinePlot[{data, minmax4}]

This too benefits from post processing with findMinimaMaxima2[]

ListLinePlot[{data, findMinimaMaxima2[minmax4]}]

But if you look closely, you see that it misses the extremes if they
go beyond the R value in several positions - including the chart's
absolute minimum and maximum as well as along the big moves up and
down.  Changing the R value shows how it misses the top and bottoms
even more:

minmax4 = findMinimaMaxima3[data, 0.15];
ListLinePlot[{data, minmax4}]

So, I need to reconsider.  Anyone can look at a plot of the data and
easily identify the important minima and maxima.  It seems harder to
get an algorithm to do it.  A window and/or an R value seem important
to the solution, but neither on their own seems enough (at least not
in the approaches above).

Can anyone extend any of the approaches shown or suggest an
alternative to identifying the important minima and maxima?

Happy to forward a notebook with all of this code and discussion in
it.  Let me know if anyone needs it.

Thank you,

  • Prev by Date: Re: a bug in Mathematica 7.0?
  • Next by Date: Re: Help with While Loop Function
  • Previous by thread: Re: Time series minima and maxima
  • Next by thread: Experimental`'NumericalFunction''