Bir dizi veride yerel zirveleri / vadileri nasıl bulurum?


17

İşte benim denemem:

Quantmod paketindeki findPeaksişlevi kullanıyorum :

Bir tolerans 5 içinde "yerel" zirveleri tespit etmek istiyorum, yani zaman serisi yerel zirvelerden 5'e düştükten sonraki ilk yerler:

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

Çıktı

[1] 3 22 41

3'ten fazla "yerel zirveleri" bekliyorum gibi yanlış görünüyor ...

Düşüncesi olan var mı?


Bu paketim yok. Kullanılan sayısal rutini tarif edebilir misiniz?
AdamO

İçin tam kaynak kodu findPeakscevabımda, @Adam. BTW, paket "quantmod" dur .
whuber

Yanıtlar:


8

Bu kodun kaynağı, adı R komut istemine yazarak elde edilir. Çıktı

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
}

Test x[pks - 1] - x[pks] > thresh, her bir tepe değerini serideki hemen başarılı olan değerle karşılaştırır (serideki bir sonraki oluğa göre değil). Zirveden hemen sonra işlevin eğim boyutunun (kaba) bir tahminini kullanır ve sadece bu eğimin threshboyutun üzerinde olduğu tepe noktalarını seçer . Sizin durumunuzda, sadece ilk üç tepe testi geçmek için yeterince keskin. Tüm zirveleri varsayılanı kullanarak tespit edeceksiniz:

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

30

Whuber'ın yanıtıyla aynı fikirdeyim ama sadece yeni bulunan zirveye uyacak şekilde dizini değiştirmeye çalışan ve "+1" olması gereken kodun "+2" kısmını eklemek istedim. örneğin elimizdeki örnekte şunu elde ederiz:

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

bir grafikte bulunan bu zirveleri vurguladığımızda (kalın kırmızı): resim açıklamasını buraya girin

gerçek zirveden sürekli olarak 1 puan uzakta olduklarını görüyoruz.

consequenty

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

olmalı pks[x[pks] - x[pks + 1] > thresh]ya dapks[x[pks] - x[pks - 1] > thresh]

BÜYÜK GÜNCELLEME

yeterli bir tepe bulma fonksiyonu bulmak için kendi arayışı aşağıdaki yazdı:

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
}

'tepe', mher iki tarafının da ondan daha küçük olduğu noktalarla yerel bir maksimadır . dolayısıyla, parametre ne kadar büyük olursa m, en yüksek fonlama prosedürü o kadar katı olur. yani:

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

fonksiyon aynı zamanda xüzerinden herhangi bir ardışık vektörün yerel minimasını bulmak için de kullanılabilir find_peaks(-x).

Not: Herkesin ihtiyacı varsa şimdi işlevi gitHub'a koydum: https://github.com/stas-g/findPeaks


6

Eek: Küçük güncelleme. Stas_G işleviyle denklik elde etmek için iki satır kod, sınırlar (-1 ve +1 ekle) değiştirmek zorunda kaldım (gerçek veri kümelerinde çok fazla 'ekstra tepe noktası' buluyordu). Herkes için özür dilerim orijinal yazım tarafından çok az yoldan sapmış.

Ben uzunca bir süredir Stas_g's find peaks algoritmasını kullanıyorum. Sadeliği nedeniyle sonraki projelerimden biri için bana faydalı oldu. Ancak, bir hesaplama için milyonlarca kez kullanmam gerekiyordu, bu yüzden onu Rcpp'de yeniden yazdım (Bkz. Rcpp paketi). Basit testlerde R versiyonundan yaklaşık 6 kat daha hızlıdır. Herkes ilgileniyorsa ben aşağıdaki kodu ekledim. Umarım birine yardım ederim, Şerefe!

Bazı küçük uyarılar. Bu fonksiyon, R kodunun tersi sırada tepe indekslerini döndürür. Ben dahil bir inhouse C ++ Sign fonksiyonu gerektirir. Tamamen optimize edilmedi, ancak daha fazla performans artışı beklenmiyor.

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

Bu döngü kusurlu görünüyor için, @caseyk: for(q = lb; q < rb; ++q){ if(vY(q) > vY(i+1)){ isGreatest = false; } }: döngü "kazanır" aracılığıyla son dönemde, eşdeğer yapıyor olarak isGreatest = vY(rb-1) <= vY(rb). Bu satırın hemen üstündeki yorumu yapmak için for döngüsünün şu şekilde değiştirilmesi gerekir:for(q = lb; isGreatest && (q < rb); ++q){ isGreatest = (vY(q) <= vY(i+1)) }
Bernhard Wagner

Hmmm. Bu kodu yazdığımdan beri çok uzun zaman oldu. IIRC, Stas_G'nin fonksiyonu ile doğrudan test edildi ve aynı sonuçları korudu. Ne dediğini görsem de, çıktıda ne gibi bir fark olacağını bilmiyorum. Önerdiğim / uyarladığım çözümünüzü araştırmanız sizin için bir gönderiye layık olacaktır.
caseyk

Ben de bu senaryoyu muhtemelen 100x (kişisel olarak projemde olduğunu varsayarak) üzerinde test ettiğimi eklemeliyim ve bir milyondan fazla kez kullanıldı ve bir literatür sonucuyla tam olarak uyumlu olan dolaylı bir sonuç sundu. belirli bir test durumu. Yani, eğer 'kusurlu' ise 'kusurlu' değildir;)
caseyk

1

Birincisi: Algoritma ayrıca düz bir platonun sağına doğru bir damla çağırır, çünkü sign(diff(x, na.pad = FALSE)) diferansiyeli -1 olacak şekilde 0 olur ve -1 olur. Basit bir düzeltme, negatif girişten önceki işaret farkının sıfır değil pozitif olmasını sağlamaktır:

    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

İkincisi: Algoritma çok yerel sonuçlar verir , örneğin dizideki ardışık üç terimin herhangi birinde bir 'yukarı' ve ardından 'aşağı'. Bunun yerine, bir sürekli sürekli fonksiyonun yerel maksimumu ile ilgileniyorsanız, o zaman - muhtemelen başka daha iyi şeyler var, ama bu benim ucuz ve acil çözümüm


  1. Verileri çok az düzleştirmek için ilk önce 3 ardışık noktadan oluşan ortalama ortalaması kullanarak zirveleri belirleyin . Ayrıca yukarıda belirtilen düz ve düşmeye karşı kontrolü kullanın.
  2. Bu adayları, düzgün olmayan bir sürüm için, her tepe noktasında ortalanmış bir pencere içindeki ortalamayı, yerel terimlerin ortalamasının ortalamasıyla karşılaştırarak filtreleyin.

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

0

Fonksiyonun platoların sonunu da tanımladığı doğrudur, ancak bence daha kolay bir düzeltme daha var: Gerçek bir zirvenin ilk farkı '1' sonra '-1' ile sonuçlanacağı için, ikinci fark '-2', ve doğrudan kontrol edebiliriz

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

Bu soruya cevap vermiyor gibi görünüyor.
Michael R.Chernick

0

Numpy kullanarak

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

veya

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

Pandaları kullanma

ser = pd.Series(np.random.randint(2, 5, 100))
peak_df = ser[(ser.shift(1) < ser) & (ser.shift(-1) < ser)]
peak = peak_df.index
Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.