R: accelerando le operazioni “group by”

Ho una simulazione che ha un enorme aggregato e unire il passo proprio nel mezzo. Ho prototipato questo processo usando la funzione ddply () di plyr che funziona alla grande per un’enorme percentuale dei miei bisogni. Ma ho bisogno che questa fase di aggregazione sia più veloce poiché devo eseguire simulazioni 10K. Sto già ridimensionando le simulazioni in parallelo, ma se questo passo fosse più veloce potrei ridurre notevolmente il numero di nodes di cui ho bisogno.

Ecco una ragionevole semplificazione di ciò che sto cercando di fare:

library(Hmisc) # Set up some example data year <- sample(1970:2008, 1e6, rep=T) state <- sample(1:50, 1e6, rep=T) group1 <- sample(1:6, 1e6, rep=T) group2 <- sample(1:3, 1e6, rep=T) myFact <- rnorm(100, 15, 1e6) weights <- rnorm(1e6) myDF <- data.frame(year, state, group1, group2, myFact, weights) # this is the step I want to make faster system.time(aggregateDF <- ddply(myDF, c("year", "state", "group1", "group2"), function(df) wtd.mean(df$myFact, weights=df$weights) ) ) 

Tutti i suggerimenti o suggerimenti sono apprezzati!

Invece del normale frame di dati R, è ansible utilizzare un frame di dati immutabile che restituisce i puntatori all’originale quando si imposta un sottoinsieme e può essere molto più veloce:

 idf < - idata.frame(myDF) system.time(aggregateDF <- ddply(idf, c("year", "state", "group1", "group2"), function(df) wtd.mean(df$myFact, weights=df$weights))) # user system elapsed # 18.032 0.416 19.250 

Se dovessi scrivere una funzione plyr personalizzata esattamente per questa situazione, farei qualcosa del genere:

 system.time({ ids < - id(myDF[c("year", "state", "group1", "group2")], drop = TRUE) data <- as.matrix(myDF[c("myFact", "weights")]) indices <- plyr:::split_indices(seq_len(nrow(data)), ids, n = attr(ids, "n")) fun <- function(rows) { weighted.mean(data[rows, 1], data[rows, 2]) } values <- vapply(indices, fun, numeric(1)) labels <- myDF[match(seq_len(attr(ids, "n")), ids), c("year", "state", "group1", "group2")] aggregateDF <- cbind(labels, values) }) # user system elapsed # 2.04 0.29 2.33 

È molto più veloce perché evita di copiare i dati, estraendo solo il sottoinsieme necessario per ogni computazione quando viene calcolato. La commutazione dei dati in forma matriciale dà un altro aumento di velocità perché il subset matrice è molto più veloce di un subset di frame dati.

Ulteriori accelerazioni 2x e codice più conciso:

 library(data.table) dtb < - data.table(myDF, key="year,state,group1,group2") system.time( res <- dtb[, weighted.mean(myFact, weights), by=list(year, state, group1, group2)] ) # user system elapsed # 0.950 0.050 1.007 

Il mio primo post, quindi per favore sii gentile;)


Da data.table v1.9.2, viene esportata la funzione setDT che convertirà data.frame in data.table per riferimento (in linea con data.table - tutte le funzioni set* modificano l'object per riferimento). Ciò significa che non è necessario copiare ed è quindi veloce. Puoi crearlo, ma sarà negligente.

 require(data.table) system.time({ setDT(myDF) res < - myDF[, weighted.mean(myFact, weights), by=list(year, state, group1, group2)] }) # user system elapsed # 0.970 0.024 1.015 

Questo è in contrasto con 1.264 secondi con la soluzione OP sopra, dove data.table(.) È usato per creare dtb .

Vorrei profilo con base R

 g < - with(myDF, paste(year, state, group1, group2)) x <- with(myDF, c(tapply(weights * myFact, g, sum) / tapply(weights, g, sum))) aggregateDF <- myDF[match(names(x), g), c("year", "state", "group1", "group2")] aggregateDF$V1 <- x 

Sulla mia macchina ci vogliono 5 secondi rispetto a 67 secondi con il codice originale.

EDIT Ho appena trovato un'altra velocità con la funzione rowsum :

 g < - with(myDF, paste(year, state, group1, group2)) X <- with(myDF, rowsum(data.frame(a=weights*myFact, b=weights), g)) x <- X$a/X$b aggregateDF2 <- myDF[match(rownames(X), g), c("year", "state", "group1", "group2")] aggregateDF2$V1 <- x 

Ci vogliono 3 secondi!

Stai usando l’ultima versione di plyr (nota: questo non è ancora disponibile per tutti i mirror CRAN)? Se è così, puoi farlo funzionare in parallelo.

Ecco l’esempio di llply, ma lo stesso dovrebbe valere per ddply:

  x < - seq_len(20) wait <- function(i) Sys.sleep(0.1) system.time(llply(x, wait)) # user system elapsed # 0.007 0.005 2.005 library(doMC) registerDoMC(2) system.time(llply(x, wait, .parallel = TRUE)) # user system elapsed # 0.020 0.011 1.038 

Modificare:

Bene, altri approcci di loop sono peggiori, quindi questo probabilmente richiede o (a) codice C / C ++ o (b) un ripensamento più fondamentale di come lo state facendo. Non ho nemmeno provato a usare by() perché è molto lento nella mia esperienza.

 groups < - unique(myDF[,c("year", "state", "group1", "group2")]) system.time( aggregateDF <- do.call("rbind", lapply(1:nrow(groups), function(i) { df.tmp <- myDF[myDF$year==groups[i,"year"] & myDF$state==groups[i,"state"] & myDF$group1==groups[i,"group1"] & myDF$group2==groups[i,"group2"],] cbind(groups[i,], wtd.mean(df.tmp$myFact, weights=df.tmp$weights)) })) ) aggregateDF <- data.frame() system.time( for(i in 1:nrow(groups)) { df.tmp <- myDF[myDF$year==groups[i,"year"] & myDF$state==groups[i,"state"] & myDF$group1==groups[i,"group1"] & myDF$group2==groups[i,"group2"],] aggregateDF <- rbind(aggregateDF, data.frame(cbind(groups[i,], wtd.mean(df.tmp$myFact, weights=df.tmp$weights)))) } ) 

Di solito uso un vettore indice con tapply quando la funzione applicata ha più argomenti vettoriali:

 system.time(tapply(1:nrow(myDF), myDF[c('year', 'state', 'group1', 'group2')], function(s) weighted.mean(myDF$myFact[s], myDF$weights[s]))) # user system elapsed # 1.36 0.08 1.44 

Io uso un semplice wrapper che è equivalente ma nasconde il casino:

 tmapply(list(myDF$myFact, myDF$weights), myDF[c('year', 'state', 'group1', 'group2')], weighted.mean) 

Modificato per includere tmapply per il commento qui sotto:

 tmapply = function(XS, INDEX, FUN, ..., simplify=T) { FUN = match.fun(FUN) if (!is.list(XS)) XS = list(XS) tapply(1:length(XS[[1L]]), INDEX, function(s, ...) do.call(FUN, c(lapply(XS, `[`, s), list(...))), ..., simplify=simplify) }