¿Cómo encontrar picos / valles locales en una serie de datos?

Aquí está mi experimento:

Estoy usando la findPeaksfunción en el paquete quantmod :

Quiero detectar picos "locales" dentro de una tolerancia 5, es decir, las primeras ubicaciones después de que la serie temporal caiga de los picos locales en 5:

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

La salida es

[1] 3 22 41

Parece incorrecto, ya que espero más "picos locales" que 3 ...

¿Alguna idea?

La fuente de este código se obtiene escribiendo su nombre en el indicador R. La salida es

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
}

La prueba x[pks - 1] - x[pks] > threshcompara cada valor máximo con el valor que le sucede inmediatamente en la serie (no con el siguiente canal de la serie). Utiliza una estimación (cruda) del tamaño de la pendiente de la función inmediatamente después del pico y selecciona solo aquellos picos donde esa pendiente excede el threshtamaño. En su caso, solo los primeros tres picos son lo suficientemente afilados para pasar la prueba. Detectará todos los picos utilizando el valor predeterminado:

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

Estoy de acuerdo con la respuesta de Whuber, pero solo quería agregar que la porción "+2" del código, que intenta cambiar el índice para que coincida con el pico recientemente encontrado, en realidad 'se sobrepasa' y debería ser "+1". por ejemplo en el ejemplo en cuestión obtenemos:

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

cuando resaltamos estos picos encontrados en un gráfico (rojo negrita):

vemos que están consistentemente a 1 punto del pico real.

consecuentemente

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

debería ser pks[x[pks] - x[pks + 1] > thresh]opks[x[pks] - x[pks - 1] > thresh]

GRAN ACTUALIZACIÓN

siguiendo mi propia búsqueda para encontrar una función adecuada de búsqueda de picos escribí esto:

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 "pico" se define como un máximo local con mpuntos a cada lado de él más pequeños que él. por lo tanto, cuanto más grande es el parámetro m, más estricto es el procedimiento de financiamiento máximo. entonces:

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

la función también se puede usar para encontrar mínimos locales de cualquier vector secuencial a xtravés de find_peaks(-x).

Nota: ahora he puesto la función en gitHub si alguien lo necesita: https://github.com/stas-g/findPeaks

Eek: actualización menor. Tuve que cambiar dos líneas de código, los límites, (agregar un -1 y +1) para alcanzar la equivalencia con la función de Stas_G (estaba encontrando demasiados 'picos adicionales' en conjuntos de datos reales). Las disculpas por cualquier persona conducen muy mal por mi publicación original.

He estado usando el algoritmo de búsqueda de picos de Stas_g desde hace bastante tiempo. Fue beneficioso para uno de mis proyectos posteriores debido a su simplicidad. Sin embargo, necesitaba usarlo millones de veces para un cálculo, así que lo reescribí en Rcpp (Ver paquete Rcpp). Es aproximadamente 6 veces más rápido que la versión R en pruebas simples. Si alguien está interesado, he agregado el código a continuación. Espero ayudar a alguien, ¡salud!

Algunas advertencias menores. Esta función devuelve índices de pico en orden inverso al código R. Requiere una función de signo C ++ interna, que incluí. No se ha optimizado por completo, pero no se esperan más ganancias de rendimiento.

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

En primer lugar: el algoritmo también llama falsamente una caída a la derecha de una meseta plana, ya sign(diff(x, na.pad = FALSE)) que será 0 y -1, por lo que su diferencia también será -1. Una solución simple es garantizar que el signo-diff que precede a la entrada negativa no sea cero sino 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

Segundo: el algoritmo da resultados muy locales, por ejemplo, un 'arriba' seguido de un 'abajo' en cualquier ejecución de tres términos consecutivos en la secuencia. Si uno está interesado en los máximos locales de una función continua con ruido, entonces, probablemente haya otras cosas mejores, pero esta es mi solución económica e inmediata.

1. Identifique los picos primero usando el promedio de 3 puntos consecutivos para
   suavizar los datos muy ligeramente. Emplee también el control mencionado anteriormente contra el plano y luego la caída.

2. filtre estos candidatos comparando, para una versión suavizada de loess, el promedio dentro de una ventana centrada en cada pico con el promedio de los términos locales afuera.

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

Es cierto que la función también identifica el final de las mesetas, pero creo que hay otra solución más fácil: dado que la primera diferencia de un pico real dará como resultado '1' y luego '-1', la segunda diferencia sería '-2', y podemos verificar directamente

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