data.table根据条件更新组中的最后一个元素

问题描述：

我有一个data.table，包含3列：id，时间和状态。对于每个id，我想用最大时间查找记录 - 然后如果对于该记录，状态为true，如果时间> 7（例如），我想将其设置为false。我按照以下方式进行。data.table根据条件更新组中的最后一个元素

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]

我有很多我正在使用的数据，并希望加快此操作。任何建议，将不胜感激！

是''内id' time'唯一的（所以就有了 “用最长时间纪录”）？ – Frank

个人而言，我更喜欢你的方法比答案更好。我将它改为'y = x [，.SD [.N，。（time，status）]，by = id] [time> 7＆status];但是[x，y，status：= FALSE]'。（'。（时间，状态）'这个东西只有在你有其他的条件不需要的变量时才有用。） – Frank

是的，时间在ID内是唯一的，所以会有最长时间的记录。 – user2506086

答

一个data.table方法是

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[order(time), .I[.N], by=id]$V1给我们的最大time的行指数为每个组（id）

而且，从@ Floo0的答案借贷，我们可以稍微简化它

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

感谢您的比较，但我认为需要两项改进：第一次比较4x3 data.table是非常无聊的。请去一个1mio x 3表左右来真正比较加速。第二：你没有键入数据表......为什么？在原来的问题中有钥匙。大多数解决方案使用''''它可能会产生巨大的差异。 – Rentrop

@ Floo0 - 1：好点，我会稍微运行一个更大的测试。2：我把原来的'setkey'作为解决方案的一部分，而不是问题。但是，我同意，如果在所有解决方案上设置了密钥，将会发生什么情况。 – SymbolixAU

我有兴趣知道为什么这得到了一个投票...？ – SymbolixAU

答

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

如果我没有记错，这是没有加入为x[,.N, by=id][,cumsum(N)]收益的行指数每组最后一个元素。

更新： 看到速度对比后，这一次似乎获胜者，应先列出

这是我这原来是最慢的所有建议的解决方案的初步尝试

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

有一件事总让我感到惊讶的是'data.table'有多灵活，可以实现多种解决方案！ – SymbolixAU

你有你的不平等表达方式错误吗？ – SymbolixAU

这太好了，正是需要的。 – user2506086

答

另一种尝试：

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

答

下面是另一种类似于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

data.table根据条件更新组中的最后一个元素

相关推荐