Come trovare picchi / valli locali in una serie di dati?

Ecco il mio esperimento:

Sto usando la findPeaksfunzione nel pacchetto quantmod :

Voglio rilevare i picchi "locali" entro una tolleranza 5, ovvero le prime posizioni dopo le serie temporali scendono dai picchi locali di 5:

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

L'output è

[1] 3 22 41

Sembra sbagliato, poiché mi aspetto più "picchi locali" di 3 ...

qualche idea?

La fonte di questo codice si ottiene digitando il suo nome al prompt R. L'output è

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
}

Il test x[pks - 1] - x[pks] > threshconfronta ciascun valore di picco con il valore immediatamente successivo nella serie (non con il successivo trogolo della serie). Utilizza una stima (grezza) della dimensione della pendenza della funzione immediatamente dopo il picco e seleziona solo quei picchi in cui tale pendenza supera le threshdimensioni. Nel tuo caso, solo i primi tre picchi sono sufficientemente nitidi per superare il test. Rileverai tutti i picchi utilizzando l'impostazione predefinita:

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

Sono d'accordo con la risposta di Whuber, ma volevo solo aggiungere che la parte "+2" del codice, che tenta di spostare l'indice in modo che corrisponda al picco appena trovato, in realtà "supera" e dovrebbe essere "+1". ad esempio nell'esempio in corso otteniamo:

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

quando evidenziamo questi picchi trovati su un grafico (rosso grassetto):

vediamo che sono costantemente a 1 punto di distanza dal picco effettivo.

consequenty

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

dovrebbe essere pks[x[pks] - x[pks + 1] > thresh]opks[x[pks] - x[pks - 1] > thresh]

GRANDE AGGIORNAMENTO

seguendo la mia ricerca per trovare un'adeguata funzione di ricerca del picco ho scritto questo:

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
}

un "picco" è definito come un massimo locale con mpunti su entrambi i lati più piccoli di esso. quindi, più grande è il parametro m, più rigorosa è la procedura di picco del finanziamento. così:

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

la funzione può anche essere utilizzata per trovare i minimi locali di qualsiasi vettore sequenziale xtramite find_peaks(-x).

Nota: ora ho impostato la funzione su gitHub se qualcuno ne ha bisogno: https://github.com/stas-g/findPeaks

Eek: aggiornamento minore. Ho dovuto cambiare due righe di codice, i limiti (aggiungere un -1 e +1) per raggiungere l'equivalenza con la funzione di Stas_G (stava trovando troppi "picchi extra" in insiemi di dati reali). Mi scuso per il fatto che qualcuno mi abbia lasciato fuori strada nel mio post originale.

Sto usando l'algoritmo find peaks di Stas_g da un po 'di tempo ormai. È stato vantaggioso per me per uno dei miei progetti successivi grazie alla sua semplicità. Tuttavia, avevo bisogno di usarlo milioni di volte per un calcolo, quindi l'ho riscritto in Rcpp (vedi pacchetto Rcpp). È circa 6 volte più veloce della versione R in semplici test. Se qualcuno è interessato ho aggiunto il codice qui sotto. Spero di aiutare qualcuno, Saluti!

Alcuni avvertimenti minori. Questa funzione restituisce gli indici di picco in ordine inverso al codice R. Richiede una funzione C ++ Sign interna, che ho incluso. Non è stato completamente ottimizzato ma non sono previsti ulteriori miglioramenti delle prestazioni.

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

In primo luogo: l'algoritmo inoltre chiama falsamente una goccia a destra di un plateau piatto poiché sign(diff(x, na.pad = FALSE)) sarà 0 quindi -1 in modo che anche la sua differenza sia -1. Una soluzione semplice è garantire che il diff di segno che precede la voce negativa non sia zero ma positivo:

    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

Secondo: l'algoritmo fornisce risultati molto locali, ad es. Un "su" seguito da un "giù" in qualsiasi sequenza di tre termini consecutivi nella sequenza. Se uno è interessato invece ai massimi locali di una funzione continua disturbata, allora - probabilmente ci sono altre cose migliori là fuori, ma questa è la mia soluzione economica e immediata

1. identificare prima i picchi utilizzando la media corrente di 3 punti consecutivi per
   rendere i dati leggermente più uniformi. Impiegare anche il controllo sopra citato contro flat quindi drop-off.

2. filtrare questi candidati confrontando, per una versione senza problemi, la media all'interno di una finestra centrata su ciascun picco con la media dei termini locali all'esterno.

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

È vero che la funzione identifica anche la fine degli altipiani, ma penso che ci sia un'altra soluzione più semplice: dal momento che la prima diff di un picco reale si tradurrà in '1' quindi '-1', la seconda diff sarebbe '-2', e possiamo controllare direttamente

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

usando Numpy

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

o

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

usando i panda

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