Demande d'accélération pour R data.table - cette fonction à deux arguments peut-elle être appliquée par groupe plus rapidement?

Question

Est-il possible d'utiliser data.table pour appliquer une fonction à deux paramètres rapidement par groupe dans un ensemble de données? Sur un ensemble de données de 1 million de lignes, je trouve qu'appeler la fonction simple définie ci-dessous prend plus de 11 secondes, ce qui est beaucoup plus long que ce à quoi je m'attendais pour quelque chose de cette complexité.

Le code autonome ci-dessous présente l'essentiel de ce que je suis en train de faire:

# generate data frame - 1 million rows 
library(data.table) 
set.seed(42) 
nn = 1e6 
daf = data.frame(aa=sample(1:1000, nn, repl=TRUE), 
       bb=sample(1:1000, nn, repl=TRUE), 
       xx=rnorm(nn), 
       yy=rnorm(nn), 
       stringsAsFactors=FALSE) 

# myfunc is the function to apply to each group 
myfunc = function(xx, yy) { 
    if (max(yy)>1) { 
    return(mean(xx)) 
    } else { 
    return(weighted.mean(yy, ifelse(xx>0, 2, 1))) 
    } 
} 

# running the function takes around 11.5 seconds 
system.time({ 
    dt = data.table(daf, key=c("aa","bb")) 
    dt = dt[,myfunc(xx, yy), by=c("aa","bb")] 
}) 

head(dt) 
# OUTPUT: 
# aa bb   V1 
# 1: 1 2 -1.02605645 
# 2: 1 3 -0.49318243 
# 3: 1 4 0.02165797 
# 4: 1 5 0.40811793 
# 5: 1 6 -1.00312393 
# 6: 1 7 0.14754417 

Est-il possible de réduire considérablement le temps d'un appel de fonction comme celui-ci? Je souhaiterais savoir s'il existe un moyen plus efficace d'effectuer le calcul ci-dessus sans réécrire complètement l'appel de fonction, ou s'il ne peut être accéléré qu'en décomposant la fonction et en la réécrivant en quelque sorte dans data.table syntaxe.

Un grand merci d'avance pour vos réponses.

Answer 1

J'ai trouvé un moyen d'obtenir une accélération supplémentaire de 8x, ce qui réduit la temps jusqu'à environ 0,2 secondes sur ma machine. Voir ci-dessous. Plutôt que de calculer la somme (yyw)/somme (w) directement pour chaque groupe, ce qui prend beaucoup de temps, nous calculons plutôt les quantités sum (yyw) et sum (w) pour chaque groupe, et seulement après effectuons la division. La magie!

system.time({ 
    dt <- data.table(daf, key = c("aa","bb")) 
    dt[, w := 1][xx > 0, w := 2] 
    dt[, yyw := yy * w] 
    res <- dt[, .(maxy = max(yy), 
       meanx = mean(xx), 
       wm2num = sum(yyw), 
       wm2den = sum(w)), 
       by = c("aa","bb")] 
    res[, wm2 := wm2num/wm2den]    
    res[, V1 := wm2][maxy > 1, V1 := meanx] 

    res[, c("maxy", "meanx", "wm2num", "wm2den", "wm2") := NULL] 
}) # 0.19 

all.equal(res, dtInitial) 
# [1] TRUE 

Answer 2

Vos résultats:

system.time({ 
    dt = data.table(daf, key = c("aa","bb")) 
    dt = dt[,myfunc(xx, yy), by = c("aa","bb")] 
}) # 21.25 
dtInitial <- copy(dt) 

V1: si les valeurs NA ne vous concerne pas, vous pouvez modifier votre fonction comme ceci:

myfunc2 = function(xx, yy) { 
    if (max(yy) > 1) { 
    return(mean(xx)) 
    } else { 
    w <- ifelse(xx > 0, 2, 1) 
    return(sum((yy * w)[w != 0])/sum(w)) 
    } 
} 

system.time({ 
    dt = data.table(daf, key = c("aa","bb")) 
    dtM = dt[, myfunc2(xx, yy), by = c("aa","bb")] 
}) # 6.69 
all.equal(dtM, dtInitial) 
# [1] TRUE 

V2:, vous pouvez aussi le faire plus vite comme ça :

system.time({ 
dt3 <- data.table(daf, key = c("aa","bb")) 
dt3[, maxy := max(yy), by = c("aa","bb")] 
dt3[, meanx := mean(xx), by = c("aa","bb")] 
dt3[, w := ifelse(xx > 0, 2, 1)] 
dt3[, wm2 := sum((yy * w)[w != 0])/sum(w), by = c("aa","bb")] 
r2 <- dt3[, .(aa, bb, V1 = ifelse(maxy > 1, meanx, wm2))] 
r2 <- unique(r2) 
}) #2.09 
all.equal(r2, dtInitial) 
# [1] TRUE 

20 sek vs 2 sek pour moi

---

Mise à jour:

Ou un peu plus vite:

system.time({ 
    dt3 <- data.table(daf, key = c("aa","bb")) 
    dt3[, w := ifelse(xx > 0, 2, 1)] 
    dt3[, yyw := yy * w] 
    r2 <- dt3[, .(maxy = max(yy), 
       meanx = mean(xx), 
       wm2 = sum(yyw)/sum(w)), 
      , by = c("aa","bb")] 
    r2[, V1 := ifelse(maxy > 1, meanx, wm2)] 
    r2[, c("maxy", "meanx", "wm2") := NULL] 
}) # 1.51 

all.equal(r2, dtInitial) 
# [1] TRUE 

Answer 3

Une autre solution

system.time({ 
    dat <- data.table(daf, key = c("aa","bb")) 
    dat[, xweight := (xx > 0) * 1 + 1] 
    result <- dat[, list(MaxY = max(yy), Mean1 = mean(xx), Mean2 = sum(yy*xweight)/sum(xweight)), keyby=c("aa", "bb")] 
    result[, FinalMean := ifelse(MaxY > 1, Mean1, Mean2)] 
}) 

    user system elapsed 
    1.964 0.059 1.348