จะค้นหายอดเขา / หุบเขาในชุดข้อมูลได้อย่างไร?


16

นี่คือการทดลองของฉัน:

ฉันใช้findPeaksฟังก์ชันในแพ็คเกจquantmod :

ฉันต้องการตรวจหายอด "ท้องถิ่น" ภายในค่าเผื่อ 5 นั่นคือตำแหน่งแรกหลังจากที่อนุกรมเวลาลดลงจากยอดเขาท้องถิ่น 5:

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

ผลลัพธ์คือ

[1] 3 22 41

ดูเหมือนว่าผิดเพราะฉันคาดว่าจะมี "ยอดเขา" มากกว่า 3 คน ...

ความคิดใด ๆ


ฉันไม่มีแพ็คเกจนี้ คุณสามารถอธิบายรูทีนตัวเลขที่กำลังใช้อยู่ได้หรือไม่?
AdamO

รหัสที่มาแบบเต็มสำหรับfindPeaksปรากฏในการตอบกลับของฉัน @Adam BTW, แพคเกจเป็น"quantmod"
whuber

ครอสโพสต์บนR-SIG การเงิน
Joshua Ulrich

คำตอบ:


8

แหล่งที่มาของรหัสนี้ได้มาจากการพิมพ์ชื่อที่พรอมต์ R ผลลัพธ์คือ

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
}

การทดสอบจะx[pks - 1] - x[pks] > threshเปรียบเทียบค่าสูงสุดแต่ละค่ากับค่าที่ทำสำเร็จในซีรีย์ทันที (ไม่ใช่กับแอพรางต่อไปในซีรีส์) มันใช้การประมาณ (อย่างหยาบ) ของขนาดของความชันของฟังก์ชันทันทีหลังจากจุดสูงสุดและเลือกเฉพาะจุดยอดที่ความชันนั้นเกินthreshขนาด ในกรณีของคุณมีเพียงสามยอดแรกเท่านั้นที่มีความคมชัดพอที่จะผ่านการทดสอบ คุณจะตรวจพบจุดสูงสุดทั้งหมดโดยใช้ค่าเริ่มต้น:

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

30

ฉันเห็นด้วยกับคำตอบของ whuber แต่เพียงต้องการเพิ่มว่าส่วน "+2" ของรหัสซึ่งพยายามที่จะเปลี่ยนดัชนีให้ตรงกับจุดสูงสุดที่พบใหม่ 'เกินจริง' จริง ๆ และควรเป็น "+1" เช่นในตัวอย่างที่เราได้รับ:

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

เมื่อเราเน้นจุดสูงสุดที่พบเหล่านี้บนกราฟ (ตัวหนาสีแดง): ป้อนคำอธิบายรูปภาพที่นี่

เราเห็นว่ามันอยู่ห่างจากจุดสูงสุดจริงอย่างสม่ำเสมอ 1 จุด

consequenty

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

ควรจะเป็นpks[x[pks] - x[pks + 1] > thresh]หรือpks[x[pks] - x[pks - 1] > thresh]

อัปเดตครั้งใหญ่

ต่อไปนี้การแสวงหาของฉันเองเพื่อค้นหาฟังก์ชั่นการค้นหาสูงสุดที่เพียงพอฉันเขียนสิ่งนี้:

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
}

a 'peak' ถูกกำหนดให้เป็น maxima ท้องถิ่นโดยมีmทั้งสองด้านของจุดนั้นเล็กกว่านั้น ดังนั้นยิ่งพารามิเตอร์ใหญ่mมากเท่าไหร่ก็จะยิ่งเข้มงวดมากขึ้นเท่านั้น ดังนั้น:

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

ฟังก์ชั่นนี้ยังสามารถใช้ในการค้นหาท้องถิ่นขั้นต่ำของเวกเตอร์ต่อเนื่อง xfind_peaks(-x)ผ่านทาง

หมายเหตุ: ตอนนี้ฉันได้วางฟังก์ชั่นบน gitHub หากใครต้องการ: https://github.com/stas-g/findPeaks


6

Eek: การอัพเดทเล็กน้อย ฉันต้องเปลี่ยนโค้ดสองบรรทัดขอบเขต (เพิ่ม -1 และ +1) เพื่อให้เทียบเท่ากับฟังก์ชั่นของ Stas_G (มันเป็นการค้นหา 'พีคพิเศษ' จำนวนมากเกินไปในชุดข้อมูลจริง) ขอโทษสำหรับทุกคนนำไปสู่การหลงผิดเล็กน้อยโดยโพสต์ต้นฉบับของฉัน

ฉันใช้อัลกอริทึม find peaks ของ Stas_g มาระยะหนึ่งแล้ว มันเป็นประโยชน์กับฉันสำหรับหนึ่งในโครงการในภายหลังของฉันเนื่องจากความเรียบง่าย อย่างไรก็ตามฉันจำเป็นต้องใช้มันนับล้านครั้งเพื่อการคำนวณดังนั้นฉันจึงเขียนมันใหม่ใน Rcpp (ดูแพ็คเกจ Rcpp) มันเร็วกว่า 6x โดยประมาณแล้วเป็นเวอร์ชั่น R ในการทดสอบอย่างง่าย หากใครสนใจฉันได้เพิ่มรหัสด้านล่าง หวังว่าฉันจะช่วยใครบางคนไชโย!

คำเตือนเล็กน้อย ฟังก์ชันนี้ส่งคืนดัชนีสูงสุดตามลำดับย้อนกลับของรหัส R มันต้องมีฟังก์ชั่นเข้าสู่ระบบ C ++ ซึ่งฉันรวมอยู่ด้วย ไม่ได้รับการปรับแต่งอย่างสมบูรณ์ แต่ไม่คาดว่าจะได้รับประสิทธิภาพเพิ่มขึ้นอีก

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

นี้สำหรับวงดูเหมือนว่าข้อบกพร่อง @caseyk: for(q = lb; q < rb; ++q){ if(vY(q) > vY(i+1)){ isGreatest = false; } }เป็นระยะสุดท้ายผ่านห่วง "ชนะ" isGreatest = vY(rb-1) <= vY(rb)ทำเทียบเท่าของ: เพื่อให้ได้สิ่งที่ความคิดเห็นข้างต้นอ้างว่าบรรทัดสำหรับวงจะต้องเปลี่ยนเป็น:for(q = lb; isGreatest && (q < rb); ++q){ isGreatest = (vY(q) <= vY(i+1)) }
Bernhard Wagner

อืมม เป็นเวลานานมากแล้วที่ฉันได้เขียนรหัสนี้ IIRC มันผ่านการทดสอบโดยตรงกับฟังก์ชั่นของ Stas_G และรักษาผลลัพธ์ที่เหมือนกัน แม้ว่าฉันจะเห็นสิ่งที่คุณพูด แต่ฉันไม่แน่ใจว่าความแตกต่างในผลลัพธ์ที่จะทำ มันจะคุ้มค่าของการโพสต์สำหรับคุณในการตรวจสอบการแก้ปัญหาของคุณเทียบกับที่ฉันเสนอ / ดัดแปลง
caseyk

ฉันควรเพิ่มว่าฉันทดสอบสคริปต์นี้โดยส่วนตัวอาจเรียงตาม 100x (สมมติว่านี่เป็นหนึ่งในโครงการของฉัน) และมันถูกใช้อย่างดีกว่าล้านครั้งและเสนอผลทางอ้อมที่สอดคล้องกับผลงานวรรณกรรมสำหรับ กรณีทดสอบเฉพาะ ดังนั้นถ้ามันเป็น 'ข้อบกพร่อง' ไม่ใช่ว่า 'มีข้อบกพร่อง';)
caseyk

1

ประการแรก: อัลกอริทึมก็เรียกการลดลงทางด้านขวาของที่ราบสูงแบนราบเนื่องจากsign(diff(x, na.pad = FALSE)) จะเป็น 0 จากนั้น -1 เพื่อให้ diff ต่างกันก็จะเป็น -1 การแก้ไขง่ายๆคือเพื่อให้แน่ใจว่าสัญญาณต่างก่อนหน้ารายการเชิงลบไม่ได้เป็นศูนย์ แต่เป็นบวก:

    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

ประการที่สอง: ขั้นตอนวิธีการให้มากผลลัพธ์ในท้องถิ่นเช่นว่า 'ขึ้น' ตามด้วย 'ลง' ในระยะสามสมัยติดต่อกันใด ๆ ในลำดับ หากมีใครสนใจแทนค่าสูงสุดในท้องถิ่นของฟังก์ชั่นต่อเนื่องที่ไม่มีเสียงรบกวน - อาจมีสิ่งอื่นที่ดีกว่าอยู่ที่นั่น แต่นี่เป็นวิธีแก้ปัญหาที่ประหยัดและทันที

  1. ระบุจุดสูงสุดก่อนโดยใช้ค่าเฉลี่ยวิ่ง 3 คะแนนติดต่อกัน
    ทำให้ข้อมูลราบรื่นขึ้นเล็กน้อย นอกจากนี้ยังใช้การควบคุมดังกล่าวข้างต้นกับแบนแล้วเลื่อนออก
  2. กรองผู้สมัครเหล่านี้โดยการเปรียบเทียบสำหรับรุ่นที่มีการปรับให้เรียบสีขาวค่าเฉลี่ยภายในหน้าต่างที่อยู่กึ่งกลางแต่ละจุดสูงสุดด้วยค่าเฉลี่ยของเงื่อนไขท้องถิ่นภายนอก

    "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

เป็นความจริงที่ฟังก์ชั่นนี้จะระบุจุดสิ้นสุดของที่ราบสูง แต่ฉันคิดว่ามันมีวิธีแก้ไขที่ง่ายกว่า: เนื่องจากความแตกต่างแรกของค่าสูงสุดจริงจะส่งผลให้ '1' จากนั้น '-1', ความต่างที่สองจะเป็น '-2' และเราสามารถตรวจสอบโดยตรง

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

ดูเหมือนจะไม่ตอบคำถาม
Michael R. Chernick

0

ใช้งาน Numpy

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

หรือ

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

ใช้หมีแพนด้า

ser = pd.Series(np.random.randint(2, 5, 100))
peak_df = ser[(ser.shift(1) < ser) & (ser.shift(-1) < ser)]
peak = peak_df.index
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.