R data.table by group替换所有缺失列的第一行

vry*_*ryb 5 r data.table

我有一个data.table,我正在尝试做类似的事情data[ !is.na(variable) ].但是,对于完全缺失的组,我只想保留该组的第一行.所以,我正在尝试使用by.我在网上做过一些研究并有一个解决方案,但我认为效率低下.

我在下面提供了一个示例,展示了我希望实现的目标,我想知道是否可以在不创建两个额外列的情况下完成此操作.

d_sample = data.table( ID = c(1, 1, 2, 2, 3, 3), 
                   Time = c(10, 15, 100, 110, 200, 220), 
                   Event = c(NA, NA, NA, 1, 1, NA))

d_sample[ !is.na(Event), isValidOutcomeRow := T, by = ID]
d_sample[ , isValidOutcomePatient := any(isValidOutcomeRow), by = ID]
d_sample[ is.na(isValidOutcomePatient), isValidOutcomeRow := c(T, rep(NA, .N - 1)), by = ID]
d_sample[ isValidOutcomeRow == T ]
Run Code Online (Sandbox Code Playgroud)

编辑:这里有一些与thelatemailFrank的解决方案的速度比较,其中包含一个包含60K行的更大数据集.

d_sample = data.table( ID = sort(rep(seq(1,30000), 2)), 
                   Time = rep(c(10, 15, 100, 110, 200, 220), 10000), 
                   Event = rep(c(NA, NA, NA, 1, 1, NA), 10000) )
Run Code Online (Sandbox Code Playgroud)

thelatemail的解决方案20.65在我的计算机上获得运行时.

system.time(d_sample[, if(all(is.na(Event))) .SD[1] else .SD[!is.na(Event)][1], by=ID])
Run Code Online (Sandbox Code Playgroud)

弗兰克的第一个解决方案获得了运行时间 0

system.time( unique( d_sample[order(is.na(Event))], by="ID" ) )
Run Code Online (Sandbox Code Playgroud)

弗兰克的第二个解决方案获得了运行时间 0.05

system.time( d_sample[order(is.na(Event)), .SD[1L], by=ID] )
Run Code Online (Sandbox Code Playgroud)

Fra*_*ank 6

这似乎有效:

unique( d_sample[order(is.na(Event))], by="ID" )

   ID Time Event
1:  2  110     1
2:  3  200     1
3:  1   10    NA
Run Code Online (Sandbox Code Playgroud)

或者,d_sample[order(is.na(Event)), .SD[1L], by=ID].


扩展OP的例子,我也发现了两种方法的类似时间:

n = 12e4 # must be a multiple of 6
set.seed(1)
d_sample = data.table( ID = sort(rep(seq(1,n/2), 2)), 
                   Time = rep(c(10, 15, 100, 110, 200, 220), n/6), 
                   Event = rep(c(NA, NA, NA, 1, 1, NA), n/6) )

system.time(rf <- unique( d_sample[order(is.na(Event))], by="ID" ))
# 1.17
system.time(rf2 <- d_sample[order(is.na(Event)), .SD[1L], by=ID] )   
# 1.24
system.time(rt <- d_sample[, if(all(is.na(Event))) .SD[1] else .SD[!is.na(Event)], by=ID])    
# 10.42
system.time(rt2 <- 
    d_sample[ d_sample[, { w = which(is.na(Event)); .I[ if (length(w) == .N) 1L else -w ] }, by=ID]$V1 ] 
)
# .13

# verify
identical(rf,rf2) # TRUE
identical(rf,rt) # FALSE
fsetequal(rf,rt) # TRUE
identical(rt,rt2) # TRUE
Run Code Online (Sandbox Code Playgroud)

@ thelatemail解决方案的变化rt2是最快的.


the*_*ail 5

这是一个可以改进的尝试,但依赖于快速if()逻辑检查来确定要返回的结果类型:

d_sample[, if(all(is.na(Event))) .SD[1] else .SD[!is.na(Event)], by=ID]
#   ID Time Event
#1:  1   10    NA
#2:  2  110     1
#3:  3  200     1
Run Code Online (Sandbox Code Playgroud)

按照@ eddi关于按组进行子集化的解决方法,这变成......

d_sample[ d_sample[, { 
  w = which(is.na(Event))
  .I[ if (length(w) == .N) 1L else -w ] 
}, by=ID]$V1 ] 
Run Code Online (Sandbox Code Playgroud)