Как найти локальные пики / долины в серии данных?

16

Вот мой эксперимент:

Я использую findPeaksфункцию в пакете quantmod :

Я хочу обнаружить «локальные» пики в пределах допуска 5, то есть первые местоположения после временного ряда падают с локальных пиков на 5:

aa=100:1
bb=sin(aa/3)
cc=aa*bb
plot(cc, type="l")
p=findPeaks(cc, 5)
points(p, cc[p])
p

Выход

[1] 3 22 41

Это кажется неправильным, так как я ожидаю больше "локальных пиков", чем 3 ...

Есть предположения?

Luna
источник
У меня нет этого пакета. Можете ли вы описать используемую числовую процедуру?
AdamO
Полный исходный код для findPeaksпоявляется в моем ответе, @ Adam. Кстати, пакет "QuantMod" .
whuber
Крест размещен на R-SIG-Finance .
Джошуа Ульрих

Ответы:

8

Источник этого кода получается путем ввода его имени в приглашении R. Выход

function (x, thresh = 0) 
{
    pks <- which(diff(sign(diff(x, na.pad = FALSE)), na.pad = FALSE) < 0) + 2
    if (!missing(thresh)) {
        pks[x[pks - 1] - x[pks] > thresh]
    }
    else pks
}

Тест x[pks - 1] - x[pks] > threshсравнивает каждое пиковое значение со значением, которое следует сразу за ним в серии (а не со следующим впадиной в серии). Он использует (грубую) оценку размера наклона функции сразу после пика и выбирает только те пики, где этот уклон превышает threshразмер. В вашем случае только первые три пика достаточно резкие, чтобы пройти тест. Вы обнаружите все пики, используя значение по умолчанию:

> findPeaks(cc)
[1]  3 22 41 59 78 96
Whuber
источник
30

Я согласен с ответом whuber, но просто хотел добавить, что часть кода «+2», которая пытается сместить индекс, чтобы соответствовать вновь найденному пику, фактически «переходит» и должна быть «+1». например, в нашем примере мы получаем:

> findPeaks(cc)
[1]  3 22 41 59 78 96

когда мы выделяем эти найденные пики на графике (жирный красный): введите описание изображения здесь

мы видим, что они последовательно 1 пункт от фактического пика.

consequenty

pks[x[pks - 1] - x[pks] > thresh]

должно быть pks[x[pks] - x[pks + 1] > thresh]илиpks[x[pks] - x[pks - 1] > thresh]

БОЛЬШОЕ ОБНОВЛЕНИЕ

после моего собственного поиска, чтобы найти адекватную функцию поиска пика, я написал это:

find_peaks <- function (x, m = 3){
    shape <- diff(sign(diff(x, na.pad = FALSE)))
    pks <- sapply(which(shape < 0), FUN = function(i){
       z <- i - m + 1
       z <- ifelse(z > 0, z, 1)
       w <- i + m + 1
       w <- ifelse(w < length(x), w, length(x))
       if(all(x[c(z : i, (i + 2) : w)] <= x[i + 1])) return(i + 1) else return(numeric(0))
    })
     pks <- unlist(pks)
     pks
}

«пик» определяется как локальные максимумы с mточками, каждая из сторон которых меньше его. следовательно, чем больше параметр m, тем более строгой является процедура пикового финансирования. так:

find_peaks(cc, m = 1)
[1]  2 21 40 58 77 95

Функция также может быть использована для поиска локальных минимумов любого последовательного вектора xчерез find_peaks(-x).

Примечание: теперь я поместил функцию на gitHub, если кому-то это нужно: https://github.com/stas-g/findPeaks

Стас г
источник
6

Eek: Незначительное обновление. Мне пришлось изменить две строки кода, границы (добавить -1 и +1), чтобы достичь эквивалентности с функцией Stas_G (она находила слишком много «дополнительных пиков» в реальных наборах данных). Извинения за кого-то очень незначительно сбивают с толку моим оригинальным постом.

Я использую алгоритм поиска пиков Stas_g уже довольно давно. Это было выгодно для меня из-за его простоты. Однако мне нужно было использовать его миллионы раз для вычислений, поэтому я переписал его в Rcpp (см. Пакет Rcpp). Это примерно в 6 раз быстрее, чем версия R в простых тестах. Если кому-то интересно, я добавил код ниже. Надеюсь, я помогу кому-то, ура!

Некоторые незначительные предостережения. Эта функция возвращает пиковые индексы в обратном порядке кода R. Это требует встроенной функции C ++ Sign, которую я включил. Он не был полностью оптимизирован, но дальнейшего повышения производительности не ожидается.

//This function returns the sign of a given real valued double.
// [[Rcpp::export]]
double signDblCPP (double x){
  double ret = 0;
  if(x > 0){ret = 1;}
  if(x < 0){ret = -1;}
  return(ret);
}

//Tested to be 6x faster(37 us vs 207 us). This operation is done from 200x per layer
//Original R function by Stas_G
// [[Rcpp::export]]
NumericVector findPeaksCPP( NumericVector vY, int m = 3) {
  int sze = vY.size();
  int i = 0;//generic iterator
  int q = 0;//second generic iterator

  int lb = 0;//left bound
  int rb = 0;//right bound

  bool isGreatest = true;//flag to state whether current index is greatest known value

  NumericVector ret(1);
  int pksFound = 0;

  for(i = 0; i < (sze-2); ++i){
    //Find all regions with negative laplacian between neighbors
    //following expression is identical to diff(sign(diff(xV, na.pad = FALSE)))
    if(signDblCPP( vY(i + 2)  - vY( i + 1 ) ) - signDblCPP( vY( i + 1 )  - vY( i ) ) < 0){
      //Now assess all regions with negative laplacian between neighbors...
      lb = i - m - 1;// define left bound of vector
      if(lb < 0){lb = 0;}//ensure our neighbor comparison is bounded by vector length
      rb = i + m + 1;// define right bound of vector
      if(rb >= (sze-2)){rb = (sze-3);}//ensure our neighbor comparison is bounded by vector length
      //Scan through loop and ensure that the neighbors are smaller in magnitude
      for(q = lb; q < rb; ++q){
        if(vY(q) > vY(i+1)){ isGreatest = false; }
      }

      //We have found a peak by our criterion
      if(isGreatest){
        if(pksFound > 0){//Check vector size.
         ret.insert( 0, double(i + 2) );
       }else{
         ret(0) = double(i + 2);
        }
        pksFound = pksFound + 1;
      }else{ // we did not find a peak, reset location is peak max flag.
        isGreatest = true;
      }//End if found peak
    }//End if laplace condition
  }//End loop
  return(ret);
}//End Fn
caseyk
источник
Это для цикла кажется ущербным, @caseyk: for(q = lb; q < rb; ++q){ if(vY(q) > vY(i+1)){ isGreatest = false; } }в последнем прогоне через петлю «победу», делая эквивалент: isGreatest = vY(rb-1) <= vY(rb). Чтобы достичь того, о чем говорится в комментарии чуть выше этой строки, цикл for необходимо изменить на:for(q = lb; isGreatest && (q < rb); ++q){ isGreatest = (vY(q) <= vY(i+1)) }
Бернхард Вагнер,
Хммм. Прошло очень много времени с тех пор, как я написал этот код. IIRC тестировался напрямую с функцией Stas_G и поддерживал точно такие же результаты. Хотя я понимаю, что вы говорите, я не уверен, какая разница в результатах будет. Было бы достойно того, чтобы вы изучили ваше решение по сравнению с тем, которое я предложил / адаптировал.
caseyk
Я должен также добавить, что я лично тестировал этот сценарий, вероятно, порядка 100x (при условии, что он используется в моем проекте), и он использовался более миллиона раз и дал косвенный результат, который полностью соответствовал литературному результату для конкретный контрольный пример. Так что, если это «недостатки», это не так «недостатки»;)
caseyk
1

Во-первых: алгоритм также ложно вызывает падение справа от плоского плато, так как sign(diff(x, na.pad = FALSE)) будет 0, а затем -1, так что его разность также будет -1. Простое исправление состоит в том, чтобы гарантировать, что разность знаков, предшествующая отрицательной записи, не равна нулю, а положительна:

    n <- length(x)
    dx.1 <- sign(diff(x, na.pad = FALSE))
    pks <- which(diff(dx.1, na.pad = FALSE) < 0 & dx.1[-(n-1)] > 0) + 1

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

  1. сначала идентифицируйте пики, используя скользящее среднее из 3 последовательных точек,
    чтобы слегка сгладить данные. Также используйте вышеупомянутый контроль против квартиры, а затем падение.
  2. отфильтруйте этих кандидатов, сравнив для сглаженной по Лессу версии среднее значение внутри окна, центрированного на каждом пике, со средним значением локальных членов снаружи.

    "myfindPeaks" <- 
    function (x, thresh=0.05, span=0.25, lspan=0.05, noisey=TRUE)
    {
      n <- length(x)
      y <- x
      mu.y.loc <- y
      if(noisey)
      {
        mu.y.loc <- (x[1:(n-2)] + x[2:(n-1)] + x[3:n])/3
        mu.y.loc <- c(mu.y.loc[1], mu.y.loc, mu.y.loc[n-2])
      }
      y.loess <- loess(x~I(1:n), span=span)
      y <- y.loess[[2]]
      sig.y <- var(y.loess$resid, na.rm=TRUE)^0.5
      DX.1 <- sign(diff(mu.y.loc, na.pad = FALSE))
      pks <- which(diff(DX.1, na.pad = FALSE) < 0 & DX.1[-(n-1)] > 0) + 1
      out <- pks
      if(noisey)
      {
        n.w <- floor(lspan*n/2)
        out <- NULL
        for(pk in pks)
        {
          inner <- (pk-n.w):(pk+n.w)
          outer <- c((pk-2*n.w):(pk-n.w),(pk+2*n.w):(pk+n.w))
          mu.y.outer <- mean(y[outer])
          if(!is.na(mu.y.outer)) 
            if (mean(y[inner])-mu.y.outer > thresh*sig.y) out <- c(out, pk)
        }
      }
      out
    }
izmirlig
источник
0

Это правда, что функция также идентифицирует конец плато, но я думаю, что есть другое более простое решение: так как первый дифференциал реального пика приведет к «1», а затем «-1», второй дифференциал будет «-2», и мы можем проверить напрямую

    pks <- which(diff(sign(diff(x, na.pad = FALSE)), na.pad = FALSE) < 1) + 1
aloHola94
источник
Это, кажется, не отвечает на вопрос.
Майкл Р. Черник
0

используя Numpy

ser = np.random.randint(-40, 40, 100) # 100 points
peak = np.where(np.diff(ser) < 0)[0]

или

double_difference = np.diff(np.sign(np.diff(ser)))
peak = np.where(double_difference == -2)[0]

используя панд

ser = pd.Series(np.random.randint(2, 5, 100))
peak_df = ser[(ser.shift(1) < ser) & (ser.shift(-1) < ser)]
peak = peak_df.index
Файзанур Рахман
источник