data.table aggiornamento ultimo elemento nel gruppo in base alla condizione

Question

Ho un data.table con 3 colonne: id, ora e stato. Per ogni id, voglio trovare il record con il tempo massimo - quindi se per quel record, lo stato è vero, voglio impostarlo su false se il tempo è> 7 (per esempio). Lo sto facendo nel modo seguente.

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] 

Ho un sacco di dati con cui sto lavorando e vorrei accelerare questa operazione. Tutti i suggerimenti sarebbero apprezzati!

Answer 1

Un data.table approccio è

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 

come x[order(time), .I[.N], by=id]$V1 ci dà l'indice di riga del massimo time per ciascun gruppo (id)

E, mutuando @ risposta di Floo0 possiamo semplificare leggermente per

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

Confronto di velocità

una prova di velocità delle varie risposte (e mantenendo i tasti sui dati)

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] 

Se non mi sbaglio, questo non è uniscono come x[,.N, by=id][,cumsum(N)] restituisce la riga-indici del ultimi elementi per gruppo.

Aggiornamento: Dopo aver visto il confronto di velocità questo sembra il vincitore e dovrebbe essere elencato prima

Questo era il mio primo tentativo, che risulta essere la più lenta di tutte le soluzioni suggerite

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

Answer 3

Un altro tentativo:

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

Ecco un altro modo, simile all'OP ' s:

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

Ecco un altro punto di riferimento:

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") 

Risultato:

 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