เร่งความเร็วการวนรอบใน R

ฉันมีปัญหาประสิทธิภาพการทำงานขนาดใหญ่ในอาร์ฉันเขียนฟังก์ชันที่วนซ้ำdata.frameวัตถุ มันเพิ่มคอลัมน์ใหม่ลงใน a data.frameและสะสมบางอย่าง (ใช้งานง่าย) data.frameมีประมาณ 850K แถว พีซีของฉันยังคงใช้งานได้ (ประมาณ 10 ชั่วโมง) และฉันไม่รู้ว่ารันไทม์

dayloop2 <- function(temp){
    for (i in 1:nrow(temp)){    
        temp[i,10] <- i
        if (i > 1) {             
            if ((temp[i,6] == temp[i-1,6]) & (temp[i,3] == temp[i-1,3])) { 
                temp[i,10] <- temp[i,9] + temp[i-1,10]                    
            } else {
                temp[i,10] <- temp[i,9]                                    
            }
        } else {
            temp[i,10] <- temp[i,9]
        }
    }
    names(temp)[names(temp) == "V10"] <- "Kumm."
    return(temp)
}

ความคิดใด ๆ วิธีเพิ่มความเร็วการดำเนินการนี้

ปัญหาที่ใหญ่ที่สุดและรากของความไม่มีประสิทธิภาพจัดทำดัชนี data.frame temp[,]ผมหมายถึงทุกบรรทัดนี้ที่คุณใช้
พยายามหลีกเลี่ยงปัญหานี้ให้มากที่สุด ฉันทำหน้าที่ของคุณเปลี่ยนการจัดทำดัชนีและที่นี่version_A

dayloop2_A <- function(temp){
    res <- numeric(nrow(temp))
    for (i in 1:nrow(temp)){    
        res[i] <- i
        if (i > 1) {             
            if ((temp[i,6] == temp[i-1,6]) & (temp[i,3] == temp[i-1,3])) { 
                res[i] <- temp[i,9] + res[i-1]                   
            } else {
                res[i] <- temp[i,9]                                    
            }
        } else {
            res[i] <- temp[i,9]
        }
    }
    temp$`Kumm.` <- res
    return(temp)
}

อย่างที่คุณเห็นฉันสร้างเวกเตอร์resที่รวบรวมผลลัพธ์ ในตอนท้ายฉันเพิ่มลงในdata.frameและฉันไม่จำเป็นต้องยุ่งกับชื่อ แล้วมันจะดีกว่านี้อย่างไร?

ผมทำงานในแต่ละฟังก์ชั่นdata.frameที่มีnrowจาก 1,000 ถึง 10,000 1,000 และวัดเวลากับsystem.time

X <- as.data.frame(matrix(sample(1:10, n*9, TRUE), n, 9))
system.time(dayloop2(X))

ผลที่ได้คือ

nrow(X)คุณจะเห็นว่ารุ่นของคุณขึ้นอยู่กับการชี้แจงจาก เวอร์ชันที่แก้ไขมีความสัมพันธ์เชิงเส้นและlmแบบจำลองอย่างง่ายทำนายว่าสำหรับการคำนวณแถว 850,000 แถวใช้เวลา 6 นาทีและ 10 วินาที

พลังของ vectorization

ในฐานะที่ Shane และ Calimo กล่าวถึงคำตอบของพวกเขา vectorization เป็นกุญแจสำคัญในการทำงานที่ดีขึ้น จากรหัสของคุณคุณสามารถย้ายออกจากวง:

• เครื่อง
• การเริ่มต้นของผลลัพธ์ (ซึ่งคือtemp[i,9])

สิ่งนี้นำไปสู่รหัสนี้

dayloop2_B <- function(temp){
    cond <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
    res <- temp[,9]
    for (i in 1:nrow(temp)) {
        if (cond[i]) res[i] <- temp[i,9] + res[i-1]
    }
    temp$`Kumm.` <- res
    return(temp)
}

เปรียบเทียบผลสำหรับฟังก์ชั่นนี้คราวนี้nrowจาก 10,000 ถึง 100,000 โดย 10,000

ปรับจูน

บิดหนึ่งคือการเปลี่ยนแปลงในการจัดทำดัชนีห่วงtemp[i,9]ไปres[i](ซึ่งเป็นที่แน่นอนเดียวกันในปีที่ i ย้ำห่วง) data.frameมันเป็นอีกความแตกต่างระหว่างการจัดทำดัชนีเวกเตอร์และจัดทำดัชนี
สิ่งที่สอง: เมื่อคุณดูลูปคุณจะเห็นว่าไม่จำเป็นต้องวนซ้ำทั้งหมดiแต่เฉพาะสำหรับลูปที่เหมาะสม
ดังนั้นที่นี่เราไป

dayloop2_D <- function(temp){
    cond <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
    res <- temp[,9]
    for (i in (1:nrow(temp))[cond]) {
        res[i] <- res[i] + res[i-1]
    }
    temp$`Kumm.` <- res
    return(temp)
}

ประสิทธิภาพที่คุณได้รับนั้นขึ้นอยู่กับโครงสร้างข้อมูล แม่นยำ - ตามเปอร์เซ็นต์ของTRUEค่าในเงื่อนไข สำหรับข้อมูลจำลองของฉันมันใช้เวลาในการคำนวณสำหรับ 850,000 แถวด้านล่างหนึ่งวินาที

ฉันต้องการให้คุณไปไกลกว่านี้ฉันเห็นอย่างน้อยสองสิ่งที่สามารถทำได้:

• เขียนCรหัสเพื่อทำ cumsum ตามเงื่อนไข

• หากคุณรู้ว่าในลำดับข้อมูลสูงสุดของคุณไม่ใหญ่คุณสามารถเปลี่ยนวนเป็น vectorized ได้ในขณะนั้น

  while (any(cond)) {
      indx <- c(FALSE, cond[-1] & !cond[-n])
      res[indx] <- res[indx] + res[which(indx)-1]
      cond[indx] <- FALSE
  }
  

รหัสที่ใช้สำหรับการจำลองและตัวเลขเป็นที่มีอยู่บน GitHub

กลยุทธ์ทั่วไปสำหรับเร่งรหัส R

ขั้นแรกให้หาว่าส่วนที่ช้านั้นเป็นอย่างไร ไม่จำเป็นต้องเพิ่มประสิทธิภาพรหัสที่ไม่ได้ทำงานช้า สำหรับโค้ดจำนวนเล็กน้อยเพียงแค่คิดผ่านมันสามารถทำงานได้ หากล้มเหลวเครื่องมือ RProf และเครื่องมือทำโปรไฟล์ที่คล้ายกันจะมีประโยชน์

เมื่อคุณพบปัญหาคอขวดให้นึกถึงอัลกอริทึมที่มีประสิทธิภาพมากขึ้นสำหรับการทำสิ่งที่คุณต้องการ การคำนวณควรจะรันเพียงครั้งเดียวถ้าทำได้ดังนั้น:

• จัดเก็บผลลัพธ์และเข้าถึงได้มากกว่าการคำนวณซ้ำ ๆ
• นำการคำนวณแบบไม่ขึ้นอยู่กับลูปออกจากลูป
• หลีกเลี่ยงการคำนวณที่ไม่จำเป็น (เช่นไม่ใช้นิพจน์ทั่วไปที่มีการค้นหาคงที่ )

การใช้ฟังก์ชั่นที่มีประสิทธิภาพมากขึ้นสามารถสร้างความเร็วเพิ่มขึ้นปานกลางหรือใหญ่ ตัวอย่างเช่นpaste0สร้างประสิทธิภาพที่เล็กน้อย แต่.colSums()และญาติของมันก็สร้างผลกำไรที่เด่นชัดขึ้น meanเป็นช้าโดยเฉพาะอย่างยิ่ง

จากนั้นคุณสามารถหลีกเลี่ยงปัญหาที่พบบ่อยโดยเฉพาะ:

• cbind จะทำให้คุณช้าลงอย่างรวดเร็วจริงๆ
• เริ่มต้นโครงสร้างข้อมูลของคุณแล้วกรอกพวกเขาในมากกว่าการขยายตัวของพวกเขาในแต่ละครั้ง
• แม้จะมีการจัดสรรล่วงหน้าคุณสามารถเปลี่ยนไปใช้วิธีส่งผ่านอ้างอิงได้แทนที่จะใช้วิธีส่งผ่านตามค่า แต่อาจไม่คุ้มค่ากับความยุ่งยาก
• ลองดูที่R Inferno เพื่อหาหลุมพรางที่ต้องหลีกเลี่ยง

ลองใช้vectorization ที่ดีกว่าซึ่งสามารถช่วยได้ แต่ก็ไม่ได้ช่วยเสมอไป ในเรื่องนี้คำสั่ง vectorized โดยเนื้อแท้ชอบifelse, diffและชอบจะให้การปรับปรุงมากกว่าapplyครอบครัวของคำสั่ง (ซึ่งให้เล็ก ๆ น้อย ๆ ที่จะเพิ่มความเร็วไม่เกินวงดีเขียน)

นอกจากนี้คุณยังสามารถลองให้ข้อมูลเพิ่มเติมเพื่อฟังก์ชั่น R ยกตัวอย่างเช่นใช้vapplyมากกว่าsapplyและระบุเมื่ออ่านในข้อมูลข้อความตามcolClasses ความเร็วที่เพิ่มขึ้นจะแปรผันตามจำนวนที่คุณคาดเดาได้

จากนั้นให้พิจารณาแพ็คเกจที่ได้รับการปรับปรุง : data.tableแพคเกจสามารถสร้างความเร็วที่เพิ่มขึ้นอย่างมากเมื่อใช้งานได้ในการจัดการข้อมูลและในการอ่านข้อมูลจำนวนมาก ( fread)

จากนั้นลองเพิ่มความเร็วด้วยวิธีที่มีประสิทธิภาพมากขึ้นในการโทรหา R :

• รวบรวมสคริปต์ R ของคุณ หรือใช้Raและjitแพ็คเกจในคอนเสิร์ตสำหรับการรวบรวมแบบทันเวลา (เดิร์คมีตัวอย่างในการนำเสนอนี้ )
• ตรวจสอบให้แน่ใจว่าคุณใช้ BLAS ที่ปรับปรุงแล้ว สิ่งเหล่านี้ให้ความเร็วเพิ่มขึ้นทั่วทั้งกระดาน จริงๆแล้วมันเป็นความอัปยศที่ R ไม่ได้ใช้ไลบรารีที่มีประสิทธิภาพที่สุดในการติดตั้งโดยอัตโนมัติ หวังว่า Revolution R จะสนับสนุนงานที่พวกเขาทำที่นี่เพื่อชุมชนโดยรวม
• ราดโอนีลได้ทำพวงของการเพิ่มประสิทธิภาพบางส่วนที่เป็นบุตรบุญธรรมเข้า R คอและอื่น ๆ อีกมากมายซึ่งถูกปิดคดเคี้ยวเป็นPQR

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

หากคุณยังคงมีปัญหาหลังจากทั้งหมดนี้คุณเพียงแค่ต้องการพลังในการคำนวณมากขึ้น มองหาการขนาน ( http://cran.r-project.org/web/views/HighPerformanceComputing.html ) หรือแม้แต่โซลูชั่นที่ใช้ GPU ( gpu-tools)

ลิงค์ไปยังคำแนะนำอื่น ๆ

• http://www.noamross.net/blog/2013/4/25/faster-talk.html

หากคุณใช้forลูปแสดงว่าคุณเป็นคนเขียนโค้ด R มากที่สุดราวกับว่าเป็น C หรือ Java หรืออย่างอื่น รหัส R ที่ถูก vectorised ถูกต้องนั้นเร็วมาก

ยกตัวอย่างโค้ดสองบิตง่ายๆนี้เพื่อสร้างรายการจำนวนเต็ม 10,000 เรียงตามลำดับ:

ตัวอย่างรหัสแรกคือวิธีที่จะใช้รหัสวนซ้ำโดยใช้กระบวนทัศน์การเข้ารหัสแบบดั้งเดิม ใช้เวลาดำเนินการ 28 วินาที

system.time({
    a <- NULL
    for(i in 1:1e5)a[i] <- i
})
   user  system elapsed 
  28.36    0.07   28.61 

คุณสามารถได้รับการปรับปรุงเกือบ 100 ครั้งโดยการดำเนินการอย่างง่ายของการจัดสรรหน่วยความจำล่วงหน้า:

system.time({
    a <- rep(1, 1e5)
    for(i in 1:1e5)a[i] <- i
})

   user  system elapsed 
   0.30    0.00    0.29 

แต่การใช้การดำเนินการเวกเตอร์ R ฐานโดยใช้ตัวดำเนินการลำไส้ใหญ่การ:ดำเนินการนี้แทบจะทันที:

system.time(a <- 1:1e5)

   user  system elapsed 
      0       0       0 

สิ่งนี้สามารถทำได้เร็วกว่ามากโดยการข้ามลูปโดยใช้ดัชนีหรือifelse()คำสั่งซ้อน

idx <- 1:nrow(temp)
temp[,10] <- idx
idx1 <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
temp[idx1,10] <- temp[idx1,9] + temp[which(idx1)-1,10] 
temp[!idx1,10] <- temp[!idx1,9]    
temp[1,10] <- temp[1,9]
names(temp)[names(temp) == "V10"] <- "Kumm."

ฉันไม่ชอบการเขียนรหัสใหม่ ... แน่นอนว่าถ้าตัวเลือกอื่นและ lapply เป็นตัวเลือกที่ดีกว่า แต่บางครั้งก็ยากที่จะทำให้พอดี

บ่อยครั้งที่ฉันใช้ data.frames จะมีการใช้รายการเช่น df$var[i]

นี่คือตัวอย่างประกอบ:

nrow=function(x){ ##required as I use nrow at times.
  if(class(x)=='list') {
    length(x[[names(x)[1]]])
  }else{
    base::nrow(x)
  }
}

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
})

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  d=as.list(d) #become a list
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
  d=as.data.frame(d) #revert back to data.frame
})

รุ่น data.frame:

   user  system elapsed 
   0.53    0.00    0.53

รายการรุ่น:

   user  system elapsed 
   0.04    0.00    0.03 

เร็วขึ้น 17 เท่าในการใช้รายการเวกเตอร์กว่า data.frame

ความคิดเห็นใด ๆ เกี่ยวกับสาเหตุของ data.frames ภายในจึงช้าในเรื่องนี้? หนึ่งคิดว่าพวกเขาทำงานเหมือนรายการ ...

สำหรับรหัสที่เร็วยิ่งขึ้นให้ทำเช่นนี้class(d)='list'แทนd=as.list(d)และclass(d)='data.frame'

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  class(d)='list'
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
  class(d)='data.frame'
})
head(d)

ดังที่อารีย์กล่าวถึงในตอนท้ายของคำตอบของเขาRcppและinlineแพ็คเกจต่างๆทำให้มันง่ายอย่างไม่น่าเชื่อในการทำสิ่งต่าง ๆ อย่างรวดเร็ว ตัวอย่างเช่นลองใช้inlineรหัสนี้(คำเตือน: ไม่ได้ทดสอบ):

body <- 'Rcpp::NumericMatrix nm(temp);
         int nrtemp = Rccp::as<int>(nrt);
         for (int i = 0; i < nrtemp; ++i) {
             temp(i, 9) = i
             if (i > 1) {
                 if ((temp(i, 5) == temp(i - 1, 5) && temp(i, 2) == temp(i - 1, 2) {
                     temp(i, 9) = temp(i, 8) + temp(i - 1, 9)
                 } else {
                     temp(i, 9) = temp(i, 8)
                 }
             } else {
                 temp(i, 9) = temp(i, 8)
             }
         return Rcpp::wrap(nm);
        '

settings <- getPlugin("Rcpp")
# settings$env$PKG_CXXFLAGS <- paste("-I", getwd(), sep="") if you want to inc files in wd
dayloop <- cxxfunction(signature(nrt="numeric", temp="numeric"), body-body,
    plugin="Rcpp", settings=settings, cppargs="-I/usr/include")

dayloop2 <- function(temp) {
    # extract a numeric matrix from temp, put it in tmp
    nc <- ncol(temp)
    nm <- dayloop(nc, temp)
    names(temp)[names(temp) == "V10"] <- "Kumm."
    return(temp)
}

มีขั้นตอนคล้ายกันในการทำ#includeสิ่งต่าง ๆ ที่คุณเพิ่งผ่านพารามิเตอร์

inc <- '#include <header.h>

เพื่อ cxxfunction include=incเป็น สิ่งที่เจ๋งจริงๆเกี่ยวกับเรื่องนี้คือการเชื่อมโยงและการรวบรวมทั้งหมดสำหรับคุณดังนั้นการสร้างต้นแบบจึงรวดเร็วมาก

ข้อจำกัดความรับผิดชอบ: ฉันไม่แน่ใจว่าคลาสของ tmp ควรเป็นตัวเลขและไม่ใช่เมทริกซ์ตัวเลขหรืออย่างอื่น แต่ส่วนใหญ่ฉันแน่ใจ

แก้ไข: ถ้าคุณยังต้องการความเร็วมากขึ้นหลังจากนี้OpenMPC++เป็นสถานที่ที่ดีสำหรับการทำคู่ขนาน ฉันไม่ได้ลองใช้มันinlineแต่มันก็ใช้ได้ดี ความคิดที่จะไปในกรณีของnแกนมีห่วงย้ำต้องดำเนินการโดยk k % nแนะนำที่เหมาะสมจะพบใน Matloff เป็นศิลปะของการวิจัยการเขียนโปรแกรมที่มีอยู่ที่นี่ในบทที่ 16 หันไปที่ C

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

dayloop2 <- function(temp){
  for (i in 1:nrow(temp)){
    cat(round(i/nrow(temp)*100,2),"%    \r") # prints the percentage complete in realtime.
    # do stuff
  }
  return(blah)
}

ทำงานร่วมกับ lapply เช่นกัน

dayloop2 <- function(temp){
  temp <- lapply(1:nrow(temp), function(i) {
    cat(round(i/nrow(temp)*100,2),"%    \r")
    #do stuff
  })
  return(temp)
}

หากฟังก์ชั่นภายในลูปนั้นค่อนข้างเร็ว แต่จำนวนลูปมีขนาดใหญ่ดังนั้นให้พิจารณาพิมพ์ทุก ๆ ครั้งเนื่องจากการพิมพ์ไปยังคอนโซลนั้นมีโอเวอร์เฮด เช่น

dayloop2 <- function(temp){
  for (i in 1:nrow(temp)){
    if(i %% 100 == 0) cat(round(i/nrow(temp)*100,2),"%    \r") # prints every 100 times through the loop
    # do stuff
  }
  return(temp)
}

ใน R คุณสามารถเพิ่มความเร็วการประมวลผลลูปได้โดยใช้applyฟังก์ชั่นตระกูล (ในกรณีของคุณมันอาจจะเป็นreplicate) ดูplyrแพ็คเกจที่มีแถบความคืบหน้า

อีกทางเลือกหนึ่งคือการหลีกเลี่ยงการวนซ้ำทั้งหมดและแทนที่ด้วย vectorized arithmetics ฉันไม่แน่ใจว่าคุณกำลังทำอะไร แต่คุณสามารถใช้ฟังก์ชันของคุณกับทุกแถวได้ในครั้งเดียว:

temp[1:nrow(temp), 10] <- temp[1:nrow(temp), 9] + temp[0:(nrow(temp)-1), 10]

นี่จะเร็วขึ้นมากแล้วจากนั้นคุณสามารถกรองแถวตามเงื่อนไขของคุณ:

cond.i <- (temp[i, 6] == temp[i-1, 6]) & (temp[i, 3] == temp[i-1, 3])
temp[cond.i, 10] <- temp[cond.i, 9]

Vectorized arithmetics ต้องใช้เวลามากขึ้นและคิดเกี่ยวกับปัญหา แต่บางครั้งคุณสามารถบันทึกคำสั่งขนาดต่าง ๆ ในเวลาดำเนินการ

การประมวลผลด้วยdata.tableเป็นตัวเลือกที่ทำงานได้:

n <- 1000000
df <- as.data.frame(matrix(sample(1:10, n*9, TRUE), n, 9))
colnames(df) <- paste("col", 1:9, sep = "")

library(data.table)

dayloop2.dt <- function(df) {
  dt <- data.table(df)
  dt[, Kumm. := {
    res <- .I;
    ifelse (res > 1,             
      ifelse ((col6 == shift(col6, fill = 0)) & (col3 == shift(col3, fill = 0)) , 
        res <- col9 + shift(res)                   
      , # else
        res <- col9                                 
      )
     , # else
      res <- col9
    )
  }
  ,]
  res <- data.frame(dt)
  return (res)
}

res <- dayloop2.dt(df)

m <- microbenchmark(dayloop2.dt(df), times = 100)
#Unit: milliseconds
#       expr      min        lq     mean   median       uq      max neval
#dayloop2.dt(df) 436.4467 441.02076 578.7126 503.9874 575.9534 966.1042    10

หากคุณไม่ได้รับผลประโยชน์จากการกรองเงื่อนไขมันจะเร็วมาก เห็นได้ชัดว่าถ้าคุณสามารถทำการคำนวณกับชุดย่อยของข้อมูลมันจะช่วย