Определите важные минимумы и максимумы во временных рядах w/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}]; 

Define 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 кажутся важными для решения, но сами по себе не кажутся достаточными (по крайней мере, не в подходах выше).

Может ли кто-либо расширить любой из предложенных подходов или предложить альтернативу определению важных минимумов и максимумов?

Happy to forward ноутбук со всем этим кодом и обсуждение в нем. Дайте мне знать, если кому-то это нужно.

Спасибо, Jagra

Answer 1

Я предлагаю использовать итеративный подход. Следующие функции взяты из this post, и в то время как они могут быть записаны более сжато без Compile, они сделают работу:

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

Вы можете изменять количество итераций, чтобы получить более крупнозернистый или тоньше минимумов/максимумов.

Edit:

на самом деле, я просто заметил, что пару очков по-прежнему не хватать этого метода, как для минимумов и максимумов. Поэтому я предлагаю это как отправную точку, а не как полное решение. Возможно, вы могли бы анализировать минимумы/максимумы, исходя из разных итераций, а иногда включать в себя те, которые были «предыдущими», более мелкозернистыми. Кроме того, единственная «физическая причина» в том, что этот вид работ заключается в том, что характер финансовых данных представляется фрактальным, с несколькими совершенно разными шкалами. Каждая итерация в вышеуказанных гнездах нацелена на конкретный масштаб. Это не так хорошо работает для произвольного сигнала.