Accelerare l'operazione di loop in R

Ho un grosso problema di prestazioni in R. Ho scritto una funzione che scorre su un data.frameoggetto. Aggiunge semplicemente una nuova colonna a data.framee accumula qualcosa. (operazione semplice). L' data.frameha approssimativamente 850K righe. Il mio PC funziona ancora (circa 10 ore adesso) e non ho idea del tempo di esecuzione.

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

Qualche idea su come velocizzare questa operazione?

Il problema maggiore e la radice dell'inefficacia è l'indicizzazione di data.frame, intendo tutte queste righe in cui si utilizza temp[,].
Cerca di evitarlo il più possibile. Ho preso la tua funzione, cambio indicizzazione e qui versione_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)
}

Come puoi vedere, creo un vettore resche raccoglie risultati. Alla fine lo aggiungo a data.framee non ho bisogno di scherzare con i nomi. Quindi quanto è meglio?

Corro ogni funzione per data.framecon nrowda 1.000 a 10.000 da 1.000 e misurare il tempo consystem.time

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

Il risultato è

Puoi vedere che la tua versione dipende in modo esponenziale nrow(X). La versione modificata ha una relazione lineare e il lmmodello semplice prevede che per 850.000 righe il calcolo richiede 6 minuti e 10 secondi.

Potenza di vettorializzazione

Come affermano Shane e Calimo nelle loro risposte, la vettorializzazione è la chiave per prestazioni migliori. Dal tuo codice potresti spostarti al di fuori del ciclo:

• condizionata
• inizializzazione dei risultati (che sono temp[i,9])

Questo porta a questo codice

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

Confronta i risultati per queste funzioni, questa volta nrowda 10.000 a 100.000 per 10.000.

Sintonizzazione del sintonizzato

Un altro tweak è a cambiare in un'indicizzazione ciclo temp[i,9]a res[i](che sono esattamente gli stessi in i-esima iterazione del ciclo). È di nuovo la differenza tra indicizzare un vettore e indicizzare a data.frame.
Seconda cosa: quando guardi il loop puoi vedere che non è necessario eseguire il loop su tutto i, ma solo per quelli che si adattano alle condizioni.
Quindi eccoci

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

Le prestazioni ottenute dipendono fortemente da una struttura di dati. Precisamente - sulla percentuale di TRUEvalori nella condizione. Per i miei dati simulati ci vuole tempo di calcolo per 850.000 righe al di sotto del secondo.

Voglio che tu possa andare oltre, vedo almeno due cose che possono essere fatte:

• scrivere un Ccodice per fare un cumsum condizionale

• se sai che nella sequenza massima dei tuoi dati non è grande, puoi cambiare loop in vettorializzato mentre, qualcosa del genere

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

Il codice utilizzato per simulazioni e figure è disponibile su GitHub .

Strategie generali per accelerare il codice R.

In primo luogo, capire dove si trova davvero la parte lenta. Non è necessario ottimizzare il codice che non viene eseguito lentamente. Per piccole quantità di codice, semplicemente pensare attraverso di esso può funzionare. In caso contrario, possono essere utili RProf e strumenti di profilazione simili.

Una volta individuato il collo di bottiglia, pensa ad algoritmi più efficienti per fare ciò che desideri. I calcoli dovrebbero essere eseguiti solo una volta, se possibile, quindi:

• Conservare i risultati e accedervi anziché ricalcolare ripetutamente
• Esegue calcoli non dipendenti dal loop dai loop
• Evita i calcoli che non sono necessari (ad es . Non usare espressioni regolari con ricerche fisse lo faranno )

L'uso di funzioni più efficienti può produrre guadagni di velocità moderati o grandi. Ad esempio, paste0produce un piccolo guadagno di efficienza ma i .colSums()suoi parenti producono guadagni un po 'più pronunciati. meanè particolarmente lento .

Quindi puoi evitare alcuni problemi particolarmente comuni :

• cbind ti rallenterà molto rapidamente.
• Inizializza le tue strutture dati, quindi compilale, anziché espanderle ogni volta .
• Anche con la pre-allocazione, è possibile passare a un approccio pass-by-reference piuttosto che a un approccio pass-by-value, ma potrebbe non valere la pena.
• Dai un'occhiata alla R Inferno per ulteriori insidie ​​da evitare.

Cerca una migliore vettorializzazione , che spesso può ma non sempre aiutare. A questo proposito, comandi intrinsecamente vettorizzati come ifelse, diffe simili forniranno un miglioramento maggiore rispetto alla applyfamiglia di comandi (che forniscono un aumento di velocità minimo o nullo su un ciclo ben scritto).

Si può anche provare a fornire maggiori informazioni alle funzioni R . Ad esempio, utilizzare vapplypiuttosto chesapply e specificare colClassesdurante la lettura di dati basati su testo . I guadagni di velocità saranno variabili in base alla quantità di ipotesi eliminate.

Successivamente, prendi in considerazione pacchetti ottimizzati : il data.tablepacchetto può produrre enormi guadagni di velocità laddove il suo utilizzo è possibile, nella manipolazione dei dati e nella lettura di grandi quantità di dati ( fread).

Quindi, prova ad aumentare la velocità attraverso mezzi più efficienti per chiamare R :

• Compila il tuo script R. Oppure usa i pacchetti Rae jitin concerto per la compilazione just-in-time (Dirk ha un esempio in questa presentazione ).
• Assicurati di utilizzare un BLAS ottimizzato. Questi forniscono guadagni di velocità su tutta la linea. Onestamente, è un peccato che R non usi automaticamente la libreria più efficiente durante l'installazione. Speriamo che Revolution R contribuirà con il lavoro che hanno svolto qui alla comunità generale.
• Radford Neal ha fatto un sacco di ottimizzazioni, alcune delle quali sono state adottate in R Core e molte altre che sono state biforcute in pqR .

E infine, se tutto quanto sopra non ti rende ancora abbastanza veloce come ti serve, potresti dover passare a una lingua più veloce per lo snippet di codice lento . La combinazione di Rcppe inlinequi rende particolarmente semplice la sostituzione della parte più lenta dell'algoritmo con il codice C ++. Qui, ad esempio, è il mio primo tentativo di farlo e fa esplodere anche soluzioni R altamente ottimizzate.

Se dopo tutto questo ti rimangono ancora problemi, hai solo bisogno di più potenza di calcolo. Esamina la parallelizzazione ( http://cran.r-project.org/web/views/HighPerformanceComputing.html ) o anche soluzioni basate su GPU ( gpu-tools).

Collegamenti ad altre indicazioni

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

Se stai usando i forloop, molto probabilmente stai codificando R come se fosse C o Java o qualcos'altro. Il codice R opportunamente vettorializzato è estremamente veloce.

Prendiamo ad esempio questi due semplici bit di codice per generare un elenco di 10.000 numeri interi in sequenza:

Il primo esempio di codice è come si codificherebbe un loop usando un paradigma di codifica tradizionale. Ci vogliono 28 secondi per completare

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

Puoi ottenere un miglioramento quasi 100 volte con la semplice azione di pre-allocazione della memoria:

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

   user  system elapsed 
   0.30    0.00    0.29 

Ma usando l'operazione vettoriale di base R usando l'operatore due punti :questa operazione è praticamente istantanea:

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

   user  system elapsed 
      0       0       0 

Questo potrebbe essere reso molto più veloce saltando i loop utilizzando indici o ifelse()istruzioni nidificate .

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

Non mi piace riscrivere il codice ... Anche ovviamente ifelse e lapply sono opzioni migliori, ma a volte è difficile adattarlo.

Spesso uso data.frames come si usano elenchi come df$var[i]

Ecco un esempio inventato:

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

versione data.frame:

   user  system elapsed 
   0.53    0.00    0.53

versione elenco:

   user  system elapsed 
   0.04    0.00    0.03 

17 volte più veloce per utilizzare un elenco di vettori rispetto a un data.frame.

Qualche commento sul perché internamente data.frames è così lento in questo senso? Si potrebbe pensare che funzionino come liste ...

Per un codice ancora più veloce, fai questo class(d)='list'invece di d=as.list(d)eclass(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)

Come ha detto Ari alla fine della sua risposta, i pacchetti Rcppe inlinerendono incredibilmente facile rendere le cose veloci. Ad esempio, prova questo inlinecodice (avviso: non testato):

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'è una procedura simile per le #includecose, in cui si passa solo un parametro

inc <- '#include <header.h>

a cxxfunction, come include=inc. La cosa davvero interessante di questo è che fa tutto il collegamento e la compilazione per te, quindi la prototipazione è davvero veloce.

Disclaimer: non sono del tutto sicuro che la classe di tmp debba essere una matrice numerica e non numerica o qualcos'altro. Ma sono per lo più sicuro.

Modifica: se dopo hai ancora bisogno di più velocità, OpenMP è una struttura di parallelizzazione adatta C++. Non ho provato a usarlo da inline, ma dovrebbe funzionare. L'idea sarebbe, nel caso di nnuclei, hanno iterazione del ciclo keffettuato dal k % n. Un'introduzione adatto si trova in Matloff è The Art of R programmazione , disponibili qui , nel capitolo 16, Il ricorso al C .

Le risposte qui sono fantastiche. Un aspetto secondario non trattato è che la domanda afferma "Il mio PC funziona ancora (circa 10 ore adesso) e non ho idea del tempo di esecuzione ". Ho sempre inserito il seguente codice in loop durante lo sviluppo per avere un'idea di come i cambiamenti sembrano influenzare la velocità e anche per monitorare il tempo necessario per il completamento.

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

Funziona anche con lapponi.

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

Se la funzione all'interno del loop è piuttosto veloce ma il numero di loop è elevato, prendere in considerazione solo la stampa ogni tanto poiché la stampa sulla console stessa ha un sovraccarico. per esempio

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

In R, puoi spesso velocizzare l'elaborazione del loop usando le applyfunzioni della famiglia (nel tuo caso, probabilmente lo sarebbe replicate). Dai un'occhiata al plyrpacchetto che fornisce barre di avanzamento.

Un'altra opzione è quella di evitare del tutto i loop e sostituirli con aritmetica vettoriale. Non sono sicuro esattamente cosa stai facendo, ma probabilmente puoi applicare la tua funzione a tutte le righe contemporaneamente:

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

Questo sarà molto più veloce e quindi puoi filtrare le righe in base alle tue condizioni:

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

L'aritmetica vettorializzata richiede più tempo e riflessione sul problema, ma a volte è possibile salvare diversi ordini di grandezza nei tempi di esecuzione.

L'elaborazione con data.tableè un'opzione praticabile:

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

Se si ignorano i possibili guadagni dal filtro delle condizioni, è molto veloce. Ovviamente, se puoi fare il calcolo sul sottoinsieme di dati, aiuta.