Як знайти місцеві вершини / долини в ряді даних?

Ось мій експеримент:

Я використовую findPeaksфункцію в квантовому пакеті:

Я хочу виявити "локальні" піки в межах допуску 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 ...

Будь-які думки?

Джерело цього коду отримується, ввівши його ім'я в рядку 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

Я погоджуюся з відповіддю Уаубера, але просто хотів додати, що частина "+2" коду, яка намагається змістити індекс, щоб відповідати нещодавно знайденому піку, насправді "прострочує" і має бути "+1". наприклад, у прикладі, який ми маємо, ми отримуємо:

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

коли ми виділимо ці знайдені вершини на графіку (жирним червоним кольором):

ми бачимо, що вони послідовно на 1 бал від фактичного піку.

внаслідок цього

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

Eek: Незначне оновлення. Мені довелося змінити два рядки коду, межі (додати -1 і +1), щоб досягти рівномірності з функцією Stas_G (це було знаходження декількох занадто багато "зайвих піків" у реальних наборах даних). Вибачення за когось не дуже збивається моїм оригінальним повідомленням.

Я вже досить давно використовую алгоритм пошуку піків Stas_g. Мені це було вигідно для одного з моїх пізніших проектів через його простоту. Мені, однак, потрібно було використовувати його мільйони разів для обчислення, тому я переписав його в Rcpp (Див. Пакет Rcpp). Це просто в 6 разів швидше, ніж версія R у простих тестах. Якщо когось цікавить, я додав код нижче. Сподіваюся, я комусь допомагаю, ура!

Деякі незначні застереження. Ця функція повертає пікові індекси у зворотному порядку R-коду. Для цього потрібна функція знаку знака C ++, яку я включив. Він не був повністю оптимізований, однак подальших підвищення продуктивності не очікується.

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

По-перше: алгоритм також помилково називає краплю праворуч плоского плато, оскільки 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
   }

Це правда, функція також визначає кінець плато, але я думаю, що є ще одне простіше виправлення: оскільки перший диференціальний реальний пік призведе до '1', то '-1', другий diff буде '-2', і ми можемо перевірити безпосередньо

    pks <- which(diff(sign(diff(x, na.pad = FALSE)), na.pad = FALSE) < 1) + 1

за допомогою 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]

використовуючи Pandas

ser = pd.Series(np.random.randint(2, 5, 100))
peak_df = ser[(ser.shift(1) < ser) & (ser.shift(-1) < ser)]
peak = peak_df.index