Tăng tốc độ hoạt động của vòng lặp trong R

Tôi có một vấn đề hiệu năng lớn trong R. Tôi đã viết một hàm lặp trên một data.frameđối tượng. Nó chỉ đơn giản là thêm một cột mới vào a data.framevà tích lũy một cái gì đó. (Hoạt động đơn giản). Có data.framekhoảng 850K hàng. PC của tôi vẫn hoạt động (khoảng 10h) và tôi không biết gì về thời gian chạy.

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

Bất kỳ ý tưởng làm thế nào để tăng tốc hoạt động này?

Vấn đề lớn nhất và gốc rễ của sự kém hiệu quả là lập chỉ mục data.frame, ý tôi là tất cả các dòng này nơi bạn sử dụng temp[,].
Cố gắng tránh điều này càng nhiều càng tốt. Tôi đã lấy chức năng của bạn, thay đổi chỉ mục và ở đây phiên bản_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)
}

Như bạn có thể thấy tôi tạo vector resthu thập kết quả. Cuối cùng, tôi thêm nó vào data.framevà tôi không cần phải lộn xộn với tên. Vậy làm thế nào tốt hơn?

Tôi chạy từng chức năng data.framevới nrowtừ 1.000 đến 10.000 bằng 1.000 và đo thời gian bằngsystem.time

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

Kết quả là

Bạn có thể thấy rằng phiên bản của bạn phụ thuộc theo cấp số nhân nrow(X). Phiên bản sửa đổi có mối quan hệ tuyến tính và lmmô hình đơn giản dự đoán rằng để tính toán 850.000 hàng mất 6 phút và 10 giây.

Sức mạnh của vector hóa

Như Shane và Calimo nói trong câu trả lời của họ, vector hóa là chìa khóa để thực hiện tốt hơn. Từ mã của bạn, bạn có thể di chuyển ra ngoài vòng lặp:

• điều hòa
• khởi tạo kết quả (đó là temp[i,9])

Điều này dẫn đến mã này

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

So sánh kết quả cho các chức năng này, lần này cho nrowtừ 10.000 đến 100.000 bằng 10.000.

Điều chỉnh điều chỉnh

Một điều chỉnh khác là thay đổi chỉ mục vòng lặp temp[i,9]thành res[i](chính xác là giống nhau trong lần lặp vòng lặp thứ i). Một lần nữa, sự khác biệt giữa lập chỉ mục một vectơ và lập chỉ mục a data.frame.
Điều thứ hai: khi bạn nhìn vào vòng lặp, bạn có thể thấy rằng không cần phải lặp lại tất cả i, mà chỉ cho những điều kiện phù hợp.
Vì vậy, ở đây chúng tôi đ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)
}

Hiệu suất mà bạn đạt được phụ thuộc nhiều vào cấu trúc dữ liệu. Chính xác - trên phần trăm của các TRUEgiá trị trong điều kiện. Đối với dữ liệu mô phỏng của tôi, phải mất thời gian tính toán cho 850.000 hàng dưới một giây.

Tôi muốn bạn có thể đi xa hơn, tôi thấy ít nhất hai điều có thể được thực hiện:

• viết Cmã để làm cumsum có điều kiện

• nếu bạn biết rằng trong chuỗi dữ liệu tối đa của bạn không lớn thì bạn có thể thay đổi vòng lặp thành vectơ trong khi, đại loại như

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

Mã được sử dụng cho mô phỏng và số liệu có sẵn trên GitHub .

Chiến lược chung để tăng tốc mã R

Thứ nhất, con số ra nơi phần chậm thực sự là. Không cần tối ưu hóa mã không chạy chậm. Đối với số lượng nhỏ mã, chỉ cần suy nghĩ thông qua nó có thể làm việc. Nếu thất bại, RProf và các công cụ định hình tương tự có thể hữu ích.

Một khi bạn tìm ra nút cổ chai, hãy nghĩ về các thuật toán hiệu quả hơn để làm những gì bạn muốn. Tính toán chỉ nên chạy một lần nếu có thể, vì vậy:

• Lưu trữ kết quả và truy cập chúng thay vì tính toán lại nhiều lần
• Lấy các phép tính không phụ thuộc vòng lặp ra khỏi các vòng lặp
• Tránh các tính toán không cần thiết (ví dụ: không sử dụng biểu thức thông thường với các tìm kiếm cố định sẽ làm )

Sử dụng các chức năng hiệu quả hơn có thể tạo ra mức tăng tốc độ trung bình hoặc lớn. Ví dụ, paste0tạo ra một mức tăng hiệu quả nhỏ nhưng .colSums()và họ hàng của nó tạo ra mức tăng rõ rệt hơn. meanlà đặc biệt chậm .

Sau đó, bạn có thể tránh một số rắc rối đặc biệt phổ biến :

• cbind sẽ làm bạn chậm lại thật nhanh
• Khởi tạo cấu trúc dữ liệu của bạn, sau đó điền chúng vào, thay vì mở rộng chúng mỗi lần .
• Ngay cả với phân bổ trước, bạn có thể chuyển sang cách tiếp cận theo tham chiếu thay vì cách tiếp cận theo giá trị, nhưng có thể không đáng để bận tâm.
• Hãy nhìn vào R Inferno để biết thêm những cạm bẫy cần tránh.

Cố gắng để vector hóa tốt hơn , có thể thường xuyên nhưng không phải lúc nào cũng giúp. Về vấn đề này, các lệnh được vector hóa như ifelse, diffvà tương tự sẽ cung cấp nhiều cải tiến hơn so với applyhọ các lệnh (cung cấp ít hoặc không tăng tốc độ trong một vòng lặp được viết tốt).

Bạn cũng có thể cố gắng để cung cấp thêm thông tin để các chức năng R . Chẳng hạn, sử dụng vapplychứ không phảisapply và chỉ định colClasseskhi đọc dữ liệu dựa trên văn bản . Tốc độ tăng sẽ thay đổi tùy thuộc vào mức độ đoán bạn loại bỏ.

Tiếp theo, hãy xem xét các gói được tối ưu hóa : data.tableGói có thể tạo ra mức tăng tốc độ lớn khi có thể sử dụng nó, trong thao tác dữ liệu và đọc số lượng lớn dữ liệu ( fread).

Tiếp theo, hãy thử tăng tốc thông qua các phương tiện gọi R hiệu quả hơn :

• Biên dịch tập lệnh R của bạn. Hoặc sử dụng Ravà jitcác gói trong buổi hòa nhạc để biên dịch đúng lúc (Dirk có một ví dụ trong bản trình bày này ).
• Hãy chắc chắn rằng bạn đang sử dụng BLAS được tối ưu hóa. Chúng cung cấp mức tăng tốc độ trên bảng. Thành thật mà nói, thật đáng tiếc khi R không tự động sử dụng thư viện hiệu quả nhất khi cài đặt. Hy vọng rằng Revolution R sẽ đóng góp công việc mà họ đã thực hiện ở đây cho cộng đồng nói chung.
• Radford Neal đã thực hiện một loạt các tối ưu hóa, một số trong số đó đã được áp dụng vào R Core và nhiều thứ khác đã được đưa vào pqR .

Và cuối cùng, nếu tất cả những điều trên vẫn không giúp bạn đạt được tốc độ nhanh như bạn cần, bạn có thể cần phải chuyển sang ngôn ngữ nhanh hơn cho đoạn mã chậm . Sự kết hợp Rcppvà inlineở đây làm cho việc thay thế chỉ phần chậm nhất của thuật toán bằng mã C ++ đặc biệt dễ dàng. Ví dụ, đây là nỗ lực đầu tiên của tôi trong việc này và nó thổi bay các giải pháp R được tối ưu hóa cao.

Nếu bạn vẫn còn gặp rắc rối sau tất cả những điều này, bạn chỉ cần thêm sức mạnh tính toán. Nhìn vào sự song song hóa ( http://cran.r-project.org/web/view/HighPerformanceComputing.html ) hoặc thậm chí các giải pháp dựa trên GPU ( gpu-tools).

Liên kết đến hướng dẫn khác

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

Nếu bạn đang sử dụng forcác vòng lặp, rất có thể bạn đang mã hóa R như thể đó là C hoặc Java hoặc một cái gì đó khác. Mã R được vector hóa đúng là cực kỳ nhanh.

Lấy ví dụ hai bit mã đơn giản này để tạo danh sách 10.000 số nguyên theo thứ tự:

Ví dụ mã đầu tiên là cách người ta sẽ mã hóa một vòng lặp bằng cách sử dụng mô hình mã hóa truyền thống. Mất 28 giây để hoàn thành

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

Bạn có thể cải thiện gần 100 lần bằng hành động đơn giản của bộ nhớ cấp phát trước:

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

   user  system elapsed 
   0.30    0.00    0.29 

Nhưng sử dụng thao tác vectơ cơ sở R bằng toán tử dấu hai chấm :, thao tác này gần như tức thời:

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

   user  system elapsed 
      0       0       0 

Điều này có thể được thực hiện nhanh hơn nhiều bằng cách bỏ qua các vòng lặp bằng cách sử dụng các chỉ mục hoặc các ifelse()câu lệnh lồng nhau .

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

Tôi không thích viết lại mã ... Tất nhiên, tất nhiên ifelse và lapply là những lựa chọn tốt hơn nhưng đôi khi rất khó để làm cho phù hợp.

Tôi thường xuyên sử dụng data.frames như người ta sẽ sử dụng các danh sách như df$var[i]

Đây là một ví dụ tạo nên:

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

phiên bản data.frame:

   user  system elapsed 
   0.53    0.00    0.53

danh sách phiên bản:

   user  system elapsed 
   0.04    0.00    0.03 

Nhanh hơn 17 lần để sử dụng danh sách các vectơ so với data.frame.

Bất kỳ ý kiến ​​về lý do tại sao data.frames nội bộ rất chậm về vấn đề này? Người ta sẽ nghĩ rằng họ hoạt động như danh sách ...

Đối với mã thậm chí nhanh hơn làm điều này class(d)='list'thay vì d=as.list(d)và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)

Như Ari đã đề cập ở cuối câu trả lời của mình, các gói Rcppvà inlinelàm cho nó cực kỳ dễ dàng để làm cho mọi thứ nhanh chóng. Ví dụ: thử inlinemã này (cảnh báo: không được kiểm tra):

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

Có một quy trình tương tự để lấy #includemọi thứ, trong đó bạn chỉ cần truyền tham số

inc <- '#include <header.h>

đến chức năng, như include=inc. Điều thực sự thú vị về điều này là nó thực hiện tất cả các liên kết và biên dịch cho bạn, vì vậy việc tạo mẫu rất nhanh.

Tuyên bố miễn trừ trách nhiệm: Tôi không hoàn toàn chắc chắn rằng lớp tmp phải là số và không phải là ma trận số hay thứ gì khác. Nhưng tôi chắc chắn là như vậy.

Chỉnh sửa: nếu bạn vẫn cần thêm tốc độ sau này, OpenMP là một phương tiện song song tốt cho C++. Tôi đã không thử sử dụng nó từ inline, nhưng nó sẽ hoạt động. Ý tưởng sẽ là, trong trường hợp nlõi, có vòng lặp kđược thực hiện bởi k % n. Một giới thiệu phù hợp được tìm thấy trong Matloff là The Art of Programming R , có sẵn ở đây , trong chương 16, phải dùng đến C .

Các câu trả lời ở đây là tuyệt vời. Một khía cạnh nhỏ không được đề cập là câu hỏi cho biết " PC của tôi vẫn hoạt động (khoảng 10h bây giờ) và tôi không biết gì về thời gian chạy ". Tôi luôn đặt các đoạn mã sau vào các vòng lặp khi phát triển để có cảm giác về những thay đổi dường như ảnh hưởng đến tốc độ và cũng để theo dõi thời gian cần thiết để hoàn thành.

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

Làm việc với lapply là tốt.

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

Nếu chức năng trong vòng lặp khá nhanh nhưng số lượng vòng lặp lớn thì hãy xem xét việc chỉ in thường xuyên vì việc in lên bàn điều khiển có một chi phí hoạt động. ví dụ

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

Trong R, bạn có thể thường xuyên tăng tốc xử lý vòng lặp bằng cách sử dụng các applyhàm gia đình (trong trường hợp của bạn, nó có thể sẽ được replicate). Có một cái nhìn vào plyrgói cung cấp thanh tiến trình.

Một lựa chọn khác là tránh các vòng lặp hoàn toàn và thay thế chúng bằng các mỹ phẩm được vector hóa. Tôi không chắc chắn chính xác những gì bạn đang làm, nhưng có lẽ bạn có thể áp dụng chức năng của mình cho tất cả các hàng cùng một lúc:

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

Điều này sẽ nhanh hơn nhiều và sau đó bạn có thể lọc các hàng với điều kiện của mình:

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

Vector arithologists đòi hỏi nhiều thời gian và suy nghĩ về vấn đề, nhưng sau đó đôi khi bạn có thể tiết kiệm một số đơn đặt hàng cường độ trong thời gian thực hiện.

Xử lý với data.tablelà một lựa chọn khả thi:

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

Nếu bạn bỏ qua lợi ích có thể có từ điều kiện lọc, nó rất nhanh. Rõ ràng, nếu bạn có thể thực hiện tính toán trên tập hợp con của dữ liệu, nó sẽ giúp ích.