data.tableグループの最後の要素を条件に基づいて更新する

Question

id、time、statusの3列のdata.tableがあります。各idに対して、最大時間のレコードを検索したい - そのレコードのステータスが真であれば、時間が7より大きい場合はfalseに設定したいと思う。私は次のようにしています。

x <- data.table(id=c(1,1,2,2),time=c(5,6,7,8),status=c(FALSE,TRUE,FALSE,TRUE)) 
setkey(x,id,time) 
y <- x[,.SD[.N],by=id] 
x[y,status:=status & time > 7] 

私は多くのデータを持っており、この操作を高速化したいと考えています。任意の提案をいただければ幸いです！

Answer 1

一つdata.tableのアプローチは、我々は

に少しそれを簡素化することができます私たちは、グループごとに最大 timeの行インデックス（ id）

を与え、、Floo0の答え@からの借入x[order(time), .I[.N], by=id]$V1として

x[ x[order(time), .I[.N], by=id]$V1 , status := ifelse(time > 7, FALSE, TRUE)] 

> x 
# id time status 
#1: 1 5 FALSE 
#2: 1 6 TRUE 
#3: 2 7 FALSE 
#4: 2 8 FALSE 

です

x[ x[order(time), .I[.N], by=id]$V1 , status := status * time <= 7] 

速度比較

様々な回答のスピードテスト（及びデータのキーを保つ）

set.seed(123) 
x <- data.table(id=c(rep(seq(1:10000), each=10)), 
       time=c(rep(seq(1:10000), 10)), 
       status=c(sample(c(TRUE, FALSE), 10000*10, replace=T))) 
setkey(x,id,time) 
x1 <- copy(x); x2 <- copy(x); x3 <- copy(x); x4 <- copy(x); x5 <- copy(x); x6 <- copy(x) 

library(microbenchmark) 

microbenchmark(

    Symbolix = {x1[ x1[order(time), .I[.N], by=id]$V1 , status := status * time < 7 ] }, 

    Floo0_1 = {x2[,status := c(.SD[-.N, status], .SD[.N, status * time > 7]), by=id]}, 

    Floo0_2 = {x3[x3[,.N, by=id][,cumsum(N)], status := status * time > 7]}, 

    Original = { 
       y <- x4[,.SD[.N],by=id] 
       x4[y,status:=status & time > 7] 
       }, 

    Frank = { 
      y <- x5[, .SD[.N, .(time, status)], by=id][time > 7 & status] 
      x5[y, status := FALSE] 
      }, 

    thelatemail = {x6[ x6[,.I==.I[which.max(time)], by=id]$V1 & time > 7, status := FALSE]} 
) 

Unit: milliseconds 
     expr   min   lq  mean  median   uq   max neval cld 
    Symbolix 5.419768 5.857477 6.514111 6.222118 6.936000 11.284580 100 a 
    Floo0_1 4550.314775 4710.679867 4787.086279 4776.794072 4850.334011 5097.136148 100 c 
    Floo0_2 1.653419 1.792378 1.945203 1.881609 2.014325 4.096006 100 a 
    Original 10.052947 10.986294 12.541595 11.431182 12.391287 89.494783 100 a 
     Frank 4609.115061 4697.687642 4743.886186 4735.086113 4785.212543 4932.270602 100 b 
thelatemail 10.300864 11.594972 12.421889 12.315852 12.984146 17.630736 100 a 

Answer 2

x[x[,.N, by=id][,cumsum(N)], status := status * time <=7] 

私は間違っていない午前場合、これはx[,.N, by=id][,cumsum(N)]リターンの行インデックスとして参加されていませんグループごとに最後の要素。

アップデート：この1つは勝者だ。これは、すべての提案ソリューションの最も遅いがあることが判明し、私の最初の試みであった

最初にリストされなければならない 速度比較を見た後

x[,status := c(.SD[-.N, status], .SD[.N, status * time <=7]), by=id] 

Answer 3

別の試み：

x[ x[,.I==.I[which.max(time)], by=id]$V1 & time > 7, status := FALSE] 
x 

# id time status 
#1: 1 5 FALSE 
#2: 1 6 TRUE 
#3: 2 7 FALSE 
#4: 2 8 FALSE 

Answer 4

これは別の方法ですが、OP ' S：ここでは

y = unique(x[,c("id","time"), with=FALSE], by="id", fromLast=TRUE) 
x[y[time > 7], status := FALSE] 

は別のベンチマークです：

n_id = 1e3; n_col = 100; n_draw = 5 

set.seed(1) 
X = data.table(id = 1:n_id)[, .(
    time = sample(10,n_draw), 
    status = sample(c(T,F), n_draw, replace=TRUE) 
), by=id][, paste0("V",1:n_col) := 0] 
setkey(X,id,time) 

X1 = copy(X); X2 = copy(X); X3 = copy(X); X4 = copy(X) 
X5 = copy(X); X6 = copy(X); X7 = copy(X); X8 = copy(X) 

library(microbenchmark) 
library(multcomp) 

microbenchmark(
unique = { 
    Y = unique(X1[,c("id","time"), with=FALSE], by="id", fromLast=TRUE) 
    X1[Y[time > 7], status := FALSE] 
}, 
OP = { 
    y <- X2[,.SD[.N],by=id] 
    X2[y,status:=status & time > 7] 
}, 
Floo0a = X3[,status := c(.SD[-.N, status], .SD[.N, status * time >7]), by=id], 
Floo0b = X4[X4[,.N, by=id][,cumsum(N)], status := status * time >7], 
tlm = X5[ X5[,.I==.I[which.max(time)], by=id]$V1 & time > 7, status := FALSE], 
Symbolix=X6[ X6[order(time), .I[.N], by=id]$V1 , status := ifelse(time > 7, FALSE, TRUE)], 
Frank1 = { 
    y <- X7[, .SD[.N, .(time, status)], by=id][time > 7 & status] 
    X7[y, status := FALSE] 
}, 
Frank2 = { 
    y <- X8[, .SD[.N], by=id][time > 7 & status] 
    X8[y, status := FALSE] 
}, times = 1, unit = "relative") 

結果：

 expr  min   lq  mean  median   uq  max neval 
    unique 1.348592 1.348592 1.348592 1.348592 1.348592 1.348592  1 
     OP 35.048724 35.048724 35.048724 35.048724 35.048724 35.048724  1 
    Floo0a 416.175654 416.175654 416.175654 416.175654 416.175654 416.175654  1 
    Floo0b 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000  1 
     tlm 2.151996 2.151996 2.151996 2.151996 2.151996 2.151996  1 
Symbolix 1.770835 1.770835 1.770835 1.770835 1.770835 1.770835  1 
    Frank1 404.045660 404.045660 404.045660 404.045660 404.045660 404.045660  1 
    Frank2 36.603303 36.603303 36.603303 36.603303 36.603303 36.603303  1