R data.tableの高速化クエリ - この2つの引数の関数をグループ単位でより迅速に適用できますか？

Question

data.tableを使用して、2つのパラメータの関数をデータセット全体でグループ単位で素早く適用できますか？ 100万行のデータセットでは、以下に定義されている単純な関数を呼び出すのが11秒以上かかることがわかりました。これは、この複雑さの何かに対して予想されるよりもはるかに長くなります。

以下の自己完結型のコードでは、私が何をしようとしています何の要点を概説：

# 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 

が大幅にこのような関数呼び出しのための時間を短縮する方法はありますか？

私は、関数呼び出しを完全に書き直すことなく上記の計算を実行するより効率的な方法があるかどうか、あるいは関数を分解して何らかの形でそれをdata.table構文。

返信いただきありがとうございます。

Answer 1

私は減少し8倍の更なる高速化を獲得する方法を見つけました私のマシンでは約0.2秒の時間がかかります。下記参照。時間のかかる、グループごとに直接sum（yyw）/ sum（w）を計算するのではなく、各グループの量sum（yyw）とsum（w）を計算し、その後で除算を実行します。マジック！あなたはifelse` `を取り除く場合

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

あなたの結果：

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：

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：NA値はあなたを心配していない場合、あなたはこのようなあなたの機能を変更することができます。また、あなたがより速く、このようにそれを行うことができます：

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

を私のためのSEK 2対

---

更新：

それとも少し速く：

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

別の解決策

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