Mempercepat operasi loop di R

Saya memiliki masalah kinerja besar di R. Saya menulis fungsi yang beralih pada data.frameobjek. Itu hanya menambahkan kolom baru ke data.framedan mengumpulkan sesuatu. (operasi sederhana). The data.framememiliki sekitar 850 ribu baris. PC saya masih berfungsi (sekitar 10 jam sekarang) dan saya tidak tahu tentang runtime.

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

Adakah cara untuk mempercepat operasi ini?

Masalah terbesar dan akar dari ketidakefektifan adalah pengindeksan data.frame, maksud saya semua baris ini di mana Anda menggunakan temp[,].
Cobalah untuk menghindari ini sebanyak mungkin. Saya mengambil fungsi Anda, mengubah pengindeksan dan di sini 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)
}

Seperti yang Anda lihat, saya membuat vektor resyang mengumpulkan hasil. Pada akhirnya saya menambahkannya data.framedan saya tidak perlu dipusingkan dengan nama. Jadi seberapa baik itu?

Saya menjalankan setiap fungsi data.framedengan nrowdari 1.000 hingga 10.000 oleh 1.000 dan mengukur waktu dengansystem.time

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

Hasilnya adalah

Anda dapat melihat bahwa versi Anda bergantung secara eksponensial nrow(X). Versi modifikasi memiliki hubungan linier, dan lmmodel sederhana memprediksi bahwa untuk 850.000 baris perhitungan membutuhkan waktu 6 menit dan 10 detik.

Kekuatan vektorisasi

Seperti yang dinyatakan Shane dan Calimo dalam jawaban mereka, vektorisasi adalah kunci kinerja yang lebih baik. Dari kode Anda, Anda bisa bergerak di luar lingkaran:

• pengkondisian
• inisialisasi hasil (yang temp[i,9])

Ini mengarah ke kode ini

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

Bandingkan hasil untuk fungsi ini, kali ini nrowdari 10.000 hingga 100.000 dengan 10.000.

Tuning yang disetel

Tweak lain adalah mengubah pengindeksan loop temp[i,9]ke res[i](yang persis sama di iterasi loop ke-i). Lagi-lagi perbedaan antara pengindeksan vektor dan pengindeksan a data.frame.
Hal kedua: ketika Anda melihat loop Anda dapat melihat bahwa tidak perlu untuk mengulang semua i, tetapi hanya untuk orang-orang yang sesuai dengan kondisi.
Jadi di sini kita mulai

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

Kinerja yang Anda peroleh sangat tergantung pada struktur data. Tepatnya - pada persen TRUEnilai dalam kondisi. Untuk data simulasi saya, dibutuhkan waktu komputasi untuk 850.000 baris di bawah satu detik.

Saya ingin Anda dapat melangkah lebih jauh, saya melihat setidaknya dua hal yang dapat dilakukan:

• menulis sebuah C kode untuk melakukan cumsum kondisional

• jika Anda tahu bahwa dalam urutan max data Anda tidak besar maka Anda dapat mengubah loop ke vektor sementara, sesuatu seperti

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

Kode yang digunakan untuk simulasi dan angka tersedia di GitHub .

Strategi umum untuk mempercepat kode R.

Pertama, cari tahu di mana bagian yang lambat itu sebenarnya. Tidak perlu mengoptimalkan kode yang tidak berjalan lambat. Untuk sejumlah kecil kode, hanya memikirkannya saja bisa berhasil. Jika itu gagal, RProf dan alat profiling serupa dapat membantu.

Setelah Anda mengetahui hambatannya, pikirkan algoritma yang lebih efisien untuk melakukan apa yang Anda inginkan. Perhitungan seharusnya hanya dijalankan sekali jika memungkinkan, jadi:

• Menyimpan hasilnya dan mengaksesnya daripada berulang kali menghitung ulang
• Keluarkan kalkulasi yang tidak tergantung loop dari loop
• Hindari perhitungan yang tidak perlu (mis. Jangan menggunakan ekspresi reguler dengan pencarian tetap akan dilakukan )

Menggunakan fungsi yang lebih efisien dapat menghasilkan peningkatan kecepatan sedang atau besar. Misalnya, paste0menghasilkan keuntungan efisiensi kecil tetapi .colSums()dan kerabatnya menghasilkan keuntungan yang agak lebih nyata. meanadalah sangat lambat .

Maka Anda dapat menghindari beberapa masalah yang sangat umum :

• cbind akan memperlambat Anda dengan sangat cepat.
• Inisialisasi struktur data Anda, lalu isi, alih-alih meluaskannya setiap kali .
• Bahkan dengan pra-alokasi, Anda bisa beralih ke pendekatan pass-by-reference daripada pendekatan pass-by-value, tetapi mungkin tidak sepadan dengan kerumitannya.
• Lihatlah R Inferno untuk menghindari lebih banyak perangkap.

Cobalah untuk vektorisasi yang lebih baik , yang seringkali dapat tetapi tidak selalu membantu. Dalam hal ini, secara inheren perintah vektor seperti ifelse,, diffdan sejenisnya akan memberikan peningkatan lebih dari applykeluarga perintah (yang memberikan sedikit atau tidak ada peningkatan kecepatan selama loop yang ditulis dengan baik).

Anda juga dapat mencoba untuk memberikan informasi lebih kepada fungsi R . Misalnya, gunakan vapplydaripadasapply , dan tentukan colClassessaat membaca dalam data berbasis teks . Keuntungan kecepatan akan bervariasi tergantung pada seberapa banyak tebakan yang Anda hilangkan.

Selanjutnya, pertimbangkan paket yang dioptimalkan : data.tablePaket ini dapat menghasilkan peningkatan kecepatan besar-besaran di mana penggunaannya dimungkinkan, dalam manipulasi data dan membaca sejumlah besar data ( fread).

Selanjutnya, cobalah untuk memperoleh kecepatan dengan cara yang lebih efisien untuk menelepon R :

• Kompilasi skrip R Anda. Atau gunakan paket Radan jitdalam konser untuk kompilasi just-in-time (Dirk memiliki contoh dalam presentasi ini ).
• Pastikan Anda menggunakan BLAS yang dioptimalkan. Ini memberikan keuntungan kecepatan secara menyeluruh. Jujur saja, sayang sekali R tidak secara otomatis menggunakan pustaka paling efisien saat dipasang. Semoga Revolution R akan menyumbangkan pekerjaan yang telah mereka lakukan di sini kembali ke masyarakat secara keseluruhan.
• Radford Neal telah melakukan banyak optimasi, beberapa di antaranya diadopsi ke dalam R Core, dan banyak lainnya yang dipalsukan menjadi pqR .

Dan terakhir, jika semua hal di atas masih membuat Anda tidak secepat yang Anda butuhkan, Anda mungkin perlu pindah ke bahasa yang lebih cepat untuk cuplikan kode yang lambat . Kombinasi dari Rcppdan di inlinesini membuat hanya mengganti bagian paling lambat dari algoritma dengan kode C ++ sangat mudah. Di sini, misalnya, adalah upaya pertama saya untuk melakukannya , dan itu meledak bahkan solusi R yang sangat dioptimalkan.

Jika Anda masih menghadapi masalah setelah semua ini, Anda hanya perlu lebih banyak daya komputasi. Lihatlah paralelisasi ( http://cran.r-project.org/web/views/HighPerformanceComputing.html ) atau bahkan solusi berbasis GPU ( gpu-tools).

Tautan ke panduan lain

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

Jika Anda menggunakan forloop, Anda kemungkinan besar mengkode R seolah-olah itu C atau Java atau yang lainnya. Kode R yang di-vectorised dengan benar sangat cepat.

Ambil contoh dua bit kode sederhana ini untuk menghasilkan daftar 10.000 integer secara berurutan:

Contoh kode pertama adalah bagaimana seseorang akan mengkode loop menggunakan paradigma pengkodean tradisional. Diperlukan 28 detik untuk menyelesaikannya

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

Anda bisa mendapatkan peningkatan hampir 100 kali dengan tindakan sederhana mengalokasikan memori:

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

   user  system elapsed 
   0.30    0.00    0.29 

Tetapi menggunakan operasi vektor R dasar menggunakan operator usus besar :operasi ini hampir seketika:

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

   user  system elapsed 
      0       0       0 

Ini bisa dibuat lebih cepat dengan melewatkan loop dengan menggunakan indeks atau ifelse()pernyataan bersarang .

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

Saya tidak suka menulis ulang kode ... Juga tentu saja ifelse dan lapply adalah pilihan yang lebih baik tetapi kadang-kadang sulit untuk membuatnya cocok.

Saya sering menggunakan data.frame karena orang akan menggunakan daftar seperti df$var[i]

Ini adalah contoh buatan:

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

versi data.frame:

   user  system elapsed 
   0.53    0.00    0.53

daftar versi:

   user  system elapsed 
   0.04    0.00    0.03 

17x kali lebih cepat untuk menggunakan daftar vektor daripada data.frame.

Ada komentar tentang mengapa data internal frame sangat lambat dalam hal ini? Orang akan berpikir mereka beroperasi seperti daftar ...

Untuk kode yang lebih cepat, lakukan ini class(d)='list'alih-alih d=as.list(d)danclass(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)

Seperti yang disebutkan Ari di akhir jawabannya, paket Rcppdan inlinemembuatnya sangat mudah untuk mempercepat. Sebagai contoh, coba inlinekode ini (peringatan: tidak diuji):

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

Ada prosedur serupa untuk memasukkan #includehal-hal, di mana Anda baru saja melewati parameter

inc <- '#include <header.h>

ke fungsi cxx, seperti include=inc. Apa yang benar-benar keren tentang ini adalah ia melakukan semua penghubungan dan kompilasi untuk Anda, jadi membuat prototipe sangat cepat.

Penafian: Saya tidak sepenuhnya yakin bahwa kelas tmp harus numerik dan bukan matriks numerik atau yang lainnya. Tapi saya yakin sebagian besar.

Sunting: jika Anda masih membutuhkan kecepatan lebih setelah ini, OpenMP adalah fasilitas paralelisasi yang baik untuk C++. Saya belum pernah mencoba menggunakannya inline, tetapi seharusnya berhasil. Idenya adalah, dalam kasus ncore, memiliki iterasi loop kdilakukan olehk % n . Sebuah pengantar yang cocok ditemukan di Matloff adalah The Art of R Programming , tersedia di sini , dalam bab 16, Beralih ke C .

Jawabannya sangat bagus. Satu aspek kecil yang tidak dicakup adalah bahwa pertanyaan menyatakan " PC saya masih berfungsi (sekitar 10 jam sekarang) dan saya tidak tahu tentang runtime ". Saya selalu memasukkan kode berikut ke dalam loop ketika mengembangkan untuk merasakan bagaimana perubahan tampaknya mempengaruhi kecepatan dan juga untuk memonitor berapa lama waktu yang dibutuhkan untuk menyelesaikannya.

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

Bekerja dengan lapply juga.

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

Jika fungsi di dalam loop cukup cepat tetapi jumlah loop besar maka pertimbangkan untuk hanya mencetak sesering mencetak ke konsol itu sendiri memiliki overhead. misalnya

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

Dalam R, Anda sering dapat mempercepat pemrosesan loop dengan menggunakan applyfungsi keluarga (dalam kasus Anda, itu mungkin akan menjadi replicate). Lihatlah plyrpaket yang menyediakan bilah kemajuan.

Pilihan lain adalah untuk menghindari loop sama sekali dan menggantinya dengan aritmatika vektor. Saya tidak yakin persis apa yang Anda lakukan, tetapi Anda mungkin dapat menerapkan fungsi Anda ke semua baris sekaligus:

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

Ini akan jauh lebih cepat, dan kemudian Anda dapat menyaring baris dengan kondisi Anda:

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

Aritmatika vektor membutuhkan lebih banyak waktu dan memikirkan masalah, tetapi terkadang Anda dapat menghemat beberapa kali lipat dalam waktu pelaksanaan.

Memproses dengan data.tableadalah opsi yang layak:

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

Jika Anda mengabaikan kemungkinan keuntungan dari penyaringan kondisi, itu sangat cepat. Tentunya, jika Anda bisa melakukan perhitungan pada subset data, ada baiknya.