Làm thế nào để tìm các đỉnh / thung lũng địa phương trong một loạt dữ liệu?


16

Đây là thí nghiệm của tôi:

Tôi đang sử dụng findPeakshàm trong gói quantmod :

Tôi muốn phát hiện các đỉnh "cục bộ" trong phạm vi dung sai 5, tức là các vị trí đầu tiên sau chuỗi thời gian giảm từ các đỉnh địa phương xuống 5:

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

Đầu ra là

[1] 3 22 41

Có vẻ như sai, vì tôi đang mong đợi nhiều "đỉnh địa phương" hơn 3 ...

Có suy nghĩ gì không?


Tôi không có gói này. Bạn có thể mô tả các thói quen số đang được sử dụng?
AdamO

Mã nguồn đầy đủ findPeaksxuất hiện trong câu trả lời của tôi, @Adam. BTW, gói là "quantmod" .
whuber

Cross đăng trên R-SIG-Finance .
Joshua Ulrich

Câu trả lời:


8

Nguồn của mã này có được bằng cách nhập tên của nó tại dấu nhắc R. Đầu ra là

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
}

Thử nghiệm x[pks - 1] - x[pks] > threshso sánh từng giá trị đỉnh với giá trị ngay lập tức thành công trong chuỗi (không phải với máng tiếp theo trong chuỗi). Nó sử dụng ước tính (thô) về kích thước độ dốc của hàm ngay sau đỉnh và chỉ chọn những đỉnh có độ dốc vượt quá threshkích thước. Trong trường hợp của bạn, chỉ có ba đỉnh đầu tiên đủ sắc nét để vượt qua bài kiểm tra. Bạn sẽ phát hiện tất cả các đỉnh bằng cách sử dụng mặc định:

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

30

Tôi đồng ý với phản hồi của người đăng ký nhưng chỉ muốn thêm phần "+2" của mã, cố gắng thay đổi chỉ mục để khớp với đỉnh mới được tìm thấy thực sự là 'vượt mức' và phải là "+1". ví dụ trong ví dụ trong tay, chúng tôi có được:

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

khi chúng tôi đánh dấu các đỉnh tìm thấy này trên biểu đồ (đậm màu đỏ): nhập mô tả hình ảnh ở đây

chúng tôi thấy rằng họ luôn cách đỉnh thực tế 1 điểm.

kết quả

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

nên pks[x[pks] - x[pks + 1] > thresh]hoặcpks[x[pks] - x[pks - 1] > thresh]

CẬP NHẬT LỚN

theo nhiệm vụ riêng của tôi để tìm một chức năng tìm đỉnh thích hợp, tôi đã viết cái này:

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ột "đỉnh" được định nghĩa là một cực đại cục bộ với mcác điểm ở hai bên của nó nhỏ hơn nó. do đó, tham số càng lớn m, quy trình cấp vốn cao nhất càng nghiêm ngặt. vì thế:

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

hàm cũng có thể được sử dụng để tìm cực tiểu cục bộ của bất kỳ vectơ tuần tự nào xthông quafind_peaks(-x) .

Lưu ý: hiện tại tôi đã đặt chức năng này trên gitHub nếu có ai cần: https://github.com/stas-g/findPeaks


6

Eek: Cập nhật nhỏ. Tôi đã phải thay đổi hai dòng mã, giới hạn, (thêm -1 và +1) để đạt được sự tương đương với chức năng của Stas_G (nó đã tìm thấy quá nhiều 'đỉnh bổ sung' trong các tập dữ liệu thực). Lời xin lỗi cho bất cứ ai dẫn rất lạc lối bởi bài viết gốc của tôi.

Tôi đã sử dụng thuật toán tìm đỉnh của Stas_g từ khá lâu rồi. Nó có lợi cho tôi cho một trong những dự án sau này của tôi do tính đơn giản của nó. Tuy nhiên, tôi cần sử dụng nó hàng triệu lần cho một tính toán vì vậy tôi đã viết lại nó trong Rcpp (Xem gói Rcpp). Nó nhanh hơn khoảng 6 lần so với phiên bản R trong các thử nghiệm đơn giản. Nếu ai quan tâm tôi đã thêm mã dưới đây. Hy vọng tôi sẽ giúp được ai đó, Chúc mừng!

Một số cảnh báo nhỏ. Hàm này trả về các chỉ số đỉnh theo thứ tự ngược của mã R. Nó đòi hỏi một chức năng Đăng nhập C ++, mà tôi bao gồm. Nó đã không được tối ưu hóa hoàn toàn nhưng bất kỳ hiệu suất tăng thêm nào không được mong đợi.

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

Vòng lặp for này có vẻ không hoàn hảo, @caseyk: for(q = lb; q < rb; ++q){ if(vY(q) > vY(i+1)){ isGreatest = false; } }là lần chạy cuối cùng trong vòng lặp "chiến thắng", thực hiện tương đương với : isGreatest = vY(rb-1) <= vY(rb). Để đạt được những gì nhận xét ngay phía trên dòng đó, vòng lặp for sẽ cần được thay đổi thành:for(q = lb; isGreatest && (q < rb); ++q){ isGreatest = (vY(q) <= vY(i+1)) }
Bernhard Wagner

Hừm. Đó là một thời gian dài thực sự kể từ khi tôi viết mã này. IIRC nó đã được thử nghiệm trực tiếp với chức năng của Stas_G và duy trì kết quả chính xác như nhau. Mặc dù tôi thấy những gì bạn đang nói, tôi không chắc sự khác biệt trong đầu ra sẽ làm gì. Nó sẽ xứng đáng với một bài đăng để bạn điều tra giải pháp của bạn so với bài tôi đề xuất / điều chỉnh.
caseyk

Tôi cũng nên nói thêm rằng cá nhân tôi đã thử nghiệm kịch bản này có thể theo thứ tự 100x (giả sử đây là kịch bản trong dự án của tôi) và nó đã được sử dụng tốt hơn một triệu lần và đưa ra một kết quả gián tiếp hoàn toàn phù hợp với kết quả văn học cho một trường hợp thử nghiệm cụ thể. Vì vậy, nếu đó là 'thiếu sót' thì đó không phải là 'thiếu sót';)
caseyk

1

Thứ nhất: Thuật toán cũng gọi sai sự sụt giảm ở bên phải của một cao nguyên phẳng vì sign(diff(x, na.pad = FALSE)) sẽ là 0 rồi -1 do đó độ lệch của nó cũng sẽ là -1. Một sửa chữa đơn giản là đảm bảo rằng dấu hiệu khác trước mục nhập âm không bằng 0 mà là dương:

    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

Thứ hai: Thuật toán cho kết quả rất cục bộ, ví dụ: 'tăng' theo sau là 'xuống' trong bất kỳ lần chạy ba thuật ngữ liên tiếp nào trong chuỗi. Thay vào đó, nếu người ta quan tâm đến cực đại cục bộ của hàm liên tục bị nhiễu, thì - có lẽ có những thứ khác tốt hơn ngoài kia, nhưng đây là giải pháp rẻ tiền và tức thời của tôi

  1. xác định các đỉnh đầu tiên bằng cách sử dụng trung bình 3 điểm liên tiếp để
    làm mịn dữ liệu từng chút một. Cũng sử dụng các điều khiển được đề cập ở trên chống lại căn hộ sau đó thả xuống.
  2. lọc các ứng cử viên này bằng cách so sánh, đối với phiên bản được làm mịn bằng hoàng thổ, mức trung bình bên trong một cửa sổ được căn giữa ở mỗi đỉnh với mức trung bình của các thuật ngữ địa phương bên ngoài.

    "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

Đúng là chức năng cũng xác định sự kết thúc của plateaux, nhưng tôi nghĩ có một cách khắc phục khác dễ dàng hơn: Vì khác biệt đầu tiên của một đỉnh thực sự sẽ dẫn đến '1' rồi '-1', khác biệt thứ hai sẽ là '-2', và chúng ta có thể kiểm tra trực tiếp

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

Điều này dường như không trả lời câu hỏi.
Michael R. Chernick

0

sử dụng Numpy

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

hoặc là

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

sử dụng gấu trúc

ser = pd.Series(np.random.randint(2, 5, 100))
peak_df = ser[(ser.shift(1) < ser) & (ser.shift(-1) < ser)]
peak = peak_df.index
Khi sử dụng trang web của chúng tôi, bạn xác nhận rằng bạn đã đọc và hiểu Chính sách cookieChính sách bảo mật của chúng tôi.
Licensed under cc by-sa 3.0 with attribution required.