使用Mathematica识别时间序列中的重要最小值和最大值

Question

我需要一种方法来识别Mathematica的时间序列数据中的局部最小值和最大值.这似乎应该是一件容易的事情,但它变得棘手.我在MathForum上发布了这个,但我想我可能会在这里得到一些额外的关注.

您可以在以下网址找到讨论该问题的论文:http://www.cs.cmu.edu/~eugene/research/full/compress-series.pdf

到目前为止我试过这个...

获取并格式化一些数据:

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

定义2个功能:

第一种方法:

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]]]]]]

现在另一种方法,虽然不那么灵活:

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

看看每个功能的作用.首先findMinimaMaxima2 []:

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

这将选择所有最小值和最大值以及结果(在本例中)约49%的数据压缩,但它没有扩展窗口的灵活性.这是另一种方法.一个2的窗口,产生更少,可以说是更重要的极值:

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

但是看看当我们将窗口扩展到60时会发生什么:

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

一些最小值和最大值不再交替.将findMinimaMaxima2 []应用于findMinimaMaxima []的输出会给出一个解决方法......

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

,但这似乎是一种解决问题的笨拙方式.

因此,使用固定窗口向左和向右看的想法并不能完全满足您的需求.我开始考虑可以使用范围值R(例如,向上或向下移动百分比)的替代方案,该函数需要满足或超过以设置下一个最小值或最大值.这是我的第一次尝试:

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]]]];
  data[[positions]]
  ]

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

这也可以通过findMinimaMaxima2 []进行后期处理

ListLinePlot[{data, findMinimaMaxima2[minmax4]}]

但是如果你仔细观察,你会发现如果它们在几个位置超过R值,它会错过极端 - 包括图表的绝对最小值和最大值以及沿着大幅度的上下移动.更改R值会显示它是如何错过顶部和底部的:

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

所以,我需要重新考虑.任何人都可以查看数据图并轻松识别重要的最小值和最大值.获得算法似乎更难.窗口和/或R值似乎对解决方案很重要,但它们本身似乎都不够(至少在上面的方法中没有).

任何人都可以扩展任何显示的方法或建议替代识别重​​要的最小值和最大值？

很高兴转发带有所有这些代码和讨论的笔记本.如果有人需要,请告诉我.

谢谢Jagra

Answer 1

我建议使用迭代方法.以下函数来自这篇文章,虽然它们可以在没有编译的情况下更简洁地编写,但它们可以完成这项工作:

localMinPositionsC = 
 Compile[{{pts, _Real, 1}}, 
   Module[{result = Table[0, {Length[pts]}], i = 1, ctr = 0}, 
    For[i = 2, i < Length[pts], i++, 
     If[pts[[i - 1]] > pts[[i]] && pts[[i + 1]] > pts[[i]], 
      result[[++ctr]] = i]];
    Take[result, ctr]]];

localMaxPositionsC = 
  Compile[{{pts, _Real, 1}}, 
    Module[{result = Table[0, {Length[pts]}], i = 1, ctr = 0}, 
      For[i = 2, i < Length[pts], i++, 
        If[pts[[i - 1]] < pts[[i]] && pts[[i + 1]] < pts[[i]], 
          result[[++ctr]] = i]];
       Take[result, ctr]]];

这是你的数据图:

dplot = ListLinePlot[data]

在这里我们绘制了在3次迭代后获得的分钟:

mins = ListPlot[Nest[#[[localMinPositionsC[#[[All, 2]]]]] &, data, 3],
   PlotStyle -> Directive[PointSize[0.015], Red]]

最大值相同:

maxs = ListPlot[Nest[#[[localMaxPositionsC[#[[All, 2]]]]] &, data, 3],
   PlotStyle -> Directive[PointSize[0.015], Green]]

由此产生的情节:

Show[{dplot, mins, maxs}]

您可以改变迭代次数,以获得更粗粒度或更精细的最小值/最大值.

编辑:

实际上,我只是注意到这个方法仍然遗漏了几个点,无论是最小值还是最大值.因此,我建议将其作为一个起点,而不是一个完整的解决方案.也许,您可以分析来自不同迭代的最小值/最大值,有时包括来自"之前",更细粒度的那些.此外,这种工作的唯一"物理原因"是,财务数据的性质似乎是分形的,具有几个明显不同的尺度.上述Nest-s中的每次迭代都以特定的比例为目标.对于任意信号,这不会很好.