Comment trouver des pics / vallées locaux dans une série de données?

Voici mon expérience:

J'utilise la findPeaksfonction dans le package quantmod :

Je veux détecter les pics "locaux" dans une tolérance de 5, c'est-à-dire les premiers emplacements après que la série chronologique ait chuté des pics locaux de 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 sortie est

[1] 3 22 41

Cela semble faux, car j'attends plus de "pics locaux" que 3 ...

Des pensées?

La source de ce code est obtenue en tapant son nom à l'invite R. La sortie est

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
}

Le test x[pks - 1] - x[pks] > threshcompare chaque valeur de crête à la valeur qui lui succède immédiatement dans la série (et non au creux suivant de la série). Il utilise une estimation (brute) de la taille de la pente de la fonction immédiatement après le pic et ne sélectionne que les pics où cette pente dépasse threshen taille. Dans votre cas, seuls les trois premiers pics sont suffisamment nets pour réussir le test. Vous détecterez tous les pics en utilisant la valeur par défaut:

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

Je suis d'accord avec la réponse de whuber, mais je voulais juste ajouter que la partie "+2" du code, qui tente de décaler l'index pour correspondre au pic nouvellement trouvé, "dépasse les limites" et devrait être "+1". par exemple dans l'exemple en question, nous obtenons:

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

lorsque nous mettons en évidence ces pics trouvés sur un graphique (rouge gras):

nous voyons qu'ils sont toujours à 1 point du pic réel.

conséquenty

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

devrait être pks[x[pks] - x[pks + 1] > thresh]oupks[x[pks] - x[pks - 1] > thresh]

GRANDE MISE À JOUR

suivant ma propre quête pour trouver une fonction de recherche de pic adéquate, j'ai écrit ceci:

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 «pic» est défini comme un maximum local dont les mpoints de chaque côté sont plus petits que lui. par conséquent, plus le paramètre est grand m, plus la procédure de financement de pointe est stricte. donc:

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

la fonction peut également être utilisée pour trouver des minima locaux de tout vecteur séquentiel xvia find_peaks(-x).

Remarque: j'ai maintenant mis la fonction sur gitHub si quelqu'un en a besoin: https://github.com/stas-g/findPeaks

Eek: mise à jour mineure. J'ai dû changer deux lignes de code, les limites, (ajouter un -1 et +1) pour atteindre l'équivalence avec la fonction de Stas_G (il trouvait trop de «pics supplémentaires» dans les ensembles de données réels). Toutes mes excuses pour toute personne qui m'égare très légèrement par mon message d'origine.

J'utilise l'algorithme de recherche de pics de Stas_g depuis un certain temps maintenant. Cela m'a été bénéfique pour l'un de mes projets ultérieurs en raison de sa simplicité. Cependant, j'avais besoin de l'utiliser des millions de fois pour un calcul, je l'ai donc réécrit dans Rcpp (voir le paquet Rcpp). Il est environ 6 fois plus rapide que la version R dans des tests simples. Si quelqu'un est intéressé, j'ai ajouté le code ci-dessous. J'espère que j'aide quelqu'un, Cheers!

Quelques mises en garde mineures. Cette fonction renvoie les indices de crête dans l'ordre inverse du code R. Il nécessite une fonction de signe C ++ interne, que j'ai incluse. Il n'a pas été complètement optimisé mais aucun gain de performances supplémentaire n'est attendu.

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

Premièrement: l'algorithme appelle également faussement une baisse à droite d'un plateau plat car sign(diff(x, na.pad = FALSE)) sera 0 puis -1 de sorte que son diff sera également -1. Une solution simple consiste à s'assurer que le signe-diff précédant l'entrée négative n'est pas nul mais positif:

    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

Deuxièmement: l'algorithme donne des résultats très locaux, par exemple un «haut» suivi d'un «bas» dans n'importe quelle série de trois termes consécutifs de la séquence. Si l'on s'intéresse plutôt aux maxima locaux d'une fonction continue bruyante, alors - il y a probablement d'autres choses meilleures là-bas, mais c'est ma solution bon marché et immédiate

1. identifiez d'abord les pics en utilisant la moyenne mobile de 3 points consécutifs pour
   lisser légèrement les données. Utilisez également le contrôle mentionné ci-dessus contre plat puis tombant.

2. filtrer ces candidats en comparant, pour une version lissée, la moyenne à l'intérieur d'une fenêtre centrée à chaque pic avec la moyenne des termes locaux à l'extérieur.

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

Il est vrai que la fonction identifie également la fin des plateaux, mais je pense qu'il existe une autre solution plus simple: puisque le premier diff d'un vrai pic se traduira par «1» puis «-1», le deuxième diff serait «-2», et nous pouvons vérifier directement

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

en utilisant Numpy

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

ou

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

en utilisant des 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