Mempercepat operasi loop di R


193

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?

Jawaban:


433

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

kinerja

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.

kinerja

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.

kinerja

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 .


2
Karena saya tidak dapat menemukan cara untuk bertanya kepada Marek secara pribadi, bagaimana grafik itu dihasilkan?
carbontwelve

@carbontwelve Apakah Anda bertanya tentang data atau plot? Plot dibuat dengan paket kisi. Jika saya punya waktu saya meletakkan kode di suatu tempat di web dan memberi Anda pemberitahuan.
Marek

@carbontwelve Ooops, saya salah :) Ini adalah plot standar (dari pangkalan R).
Marek

@ Gregor Sayangnya tidak. Ini kumulatif sehingga Anda tidak bisa membuat vektornya. Contoh sederhana: res = c(1,2,3,4)dan condsemua TRUE, maka hasil akhir harus: 1, 3(penyebab 1+2), 6(penyebab kedua adalah sekarang 3, dan ketiga adalah 3juga), 10( 6+4). Melakukan penjumlahan sederhana yang Anda punya 1, 3, 5, 7.
Marek

Ah, seharusnya aku memikirkannya lebih hati-hati. Terima kasih telah menunjukkan kesalahannya padaku.
Gregor Thomas

132

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:

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


35

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 

+1 meskipun saya akan menganggap contoh kedua Anda tidak meyakinkan karena a[i]tidak berubah. Tetapi system.time({a <- NULL; for(i in 1:1e5){a[i] <- 2*i} }); system.time({a <- 1:1e5; for(i in 1:1e5){a[i] <- 2*i} }); system.time({a <- NULL; a <- 2*(1:1e5)})memiliki hasil yang serupa.
Henry

@ Henry, komentar yang adil, tetapi seperti yang Anda tunjukkan, hasilnya sama. Saya telah memodifikasi contoh untuk menginisialisasi ke rep(1, 1e5)- timingnya identik.
Andrie

17

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

Terima kasih atas jawabannya. Saya mencoba memahami pernyataan Anda. Baris 4: "temp [idx1,10] <- temp [idx1,9] + temp [yang (idx1) -1,10]" menyebabkan kesalahan karena panjang objek yang lebih panjang bukan kelipatan dari panjang objek. objek yang lebih pendek. "temp [idx1,9] = num [1: 11496]" dan "temp [that (idx1) -1,10] = int [1: 11494]" sehingga 2 baris tidak ada.
Kay

Jika Anda memberikan sampel data (gunakan dput () dengan beberapa baris) maka saya akan memperbaikinya untuk Anda. Karena yang () - 1 bit, indeksnya tidak sama. Tetapi Anda harus melihat cara kerjanya dari sini: tidak perlu untuk mengulang atau menerapkan; cukup gunakan fungsi vektor.
Shane

1
Wow! Saya baru saja mengubah blok fungsi if..else fungsi dan mapply, menjadi fungsi ifelse bersarang dan mendapat speedup 200x!
James

Nasihat umum Anda benar, tetapi dalam kode Anda melewatkan fakta, bahwa inilai -th tergantung pada i-1-th sehingga mereka tidak dapat diatur dengan cara Anda melakukannya (menggunakan which()-1).
Marek

8

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)

1
Ini mungkin berkat overhead [<-.data.frame, yang entah bagaimana dipanggil ketika Anda lakukan d$foo[i] = markdan mungkin akhirnya membuat salinan baru vektor dari kemungkinan seluruh data. Bingkai pada setiap <-modifikasi. Itu akan membuat pertanyaan menarik pada SO.
Frank

2
@ Frank It (i) harus memastikan bahwa objek yang dimodifikasi masih merupakan data.frame yang valid dan (ii) afaik membuat setidaknya satu salinan, mungkin lebih dari satu. Subassignment dataframe diketahui lambat dan jika Anda melihat kode sumber yang panjang itu tidak terlalu mengejutkan.
Roland

@ Jujur, @Roland: Apakah df$var[i]notasi melalui [<-.data.framefungsi yang sama ? Saya perhatikan itu memang cukup lama. Jika tidak, fungsi apa yang digunakannya?
Chris

@ Chris Saya percaya d$foo[i]=markakan diterjemahkan secara kasar ke dalam d <- `$<-`(d, 'foo', `[<-`(d$foo, i, mark)), tetapi dengan beberapa penggunaan variabel sementara.
Tim Goodman

7

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 .


3

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

Pilihan serupa, cetak pecahan i / n. Saya selalu memiliki sesuatu seperti cat(sprintf("\nNow running... %40s, %s/%s \n", nm[i], i, n))karena saya biasanya mengulangi hal-hal yang disebutkan (dengan nama di nm).
Frank

2

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.


14
Anda mengetahui bahwa fungsi vektor akan lebih cepat daripada loop atau apply () tetapi tidak benar bahwa apply () lebih cepat dari loop. Dalam banyak kasus berlaku () hanya mengabstraksi loop menjauh dari pengguna tetapi masih looping. Lihat pertanyaan sebelumnya: stackoverflow.com/questions/2275896/…
JD Long

0

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.


2
Mengapa Anda mengulangi saran untuk menggunakan data.table? Sudah dibuat beberapa kali dalam jawaban sebelumnya.
IRTFM
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.