应用于data.table行:查找列子集全部为NA的行

Question

我正在尝试用data.table包重写旧(慢)代码,以找出apply与data.table 一起使用的最佳方法.

我有一个带有多个id列的data.table,然后是多列,它们具有宽格式的剂量响应数据.我需要概括答案,因为并非所有data.tables都具有相同数量的剂量反应列.为简单起见,我认为以下data.table解决了这个问题:

library(data.table)
library(microbenchmark)
set.seed(1234)
DT1 =  data.table(unique_id = paste0('id',1:1e6),
                 dose1 = sample(c(1:9,NA),1e6,replace=TRUE),
                 dose2 = sample(c(1:9,NA),1e6,replace=TRUE)
                 )

> DT1
          unique_id dose1 dose2
       1:       id1     2     2
       2:       id2     7     4
       3:       id3     7     9
       4:       id4     7     4
       5:       id5     9     3
---                      
  999996:  id999996     4     3
  999997:  id999997    NA     3
  999998:  id999998     4     2
  999999:  id999999     8     5
 1000000: id1000000     6     7

所以每一行都有一个唯一的id,一些其他id,我遗漏了响应列,因为它们将是NA剂量列的位置NA.我需要做的是删除所有剂量列所在的行NA.我想出了第一个选项,然后意识到我可以将它修剪到第二个选项.

DT2 <- copy(DT1)
DT3 <- copy(DT1)

len.not.na <- function(x){length(which(!is.na(x)))}

option1 <- function(DT){
  DT[,flag := apply(.SD,1,len.not.na),.SDcols=grep("dose",colnames(DT))]
  DT <- DT[flag != 0]
  DT[ , flag := NULL ]
}

option2 <- function(DT){
  DT[ apply(DT[,grep("dose",colnames(DT)),with=FALSE],1,len.not.na) != 0 ]
}

> microbenchmark(op1 <- option1(DT2), op2 <- option2(DT3),times=25L)
Unit: seconds
                expr      min       lq   median       uq      max neval
 op1 <- option1(DT2) 8.364504 8.863436 9.145341 11.27827 11.50356    25
 op2 <- option2(DT3) 8.291549 8.774746 8.982536 11.15269 11.72199    25

很明显,他们有两个选项可以做同样的事情,选项1有更多的步骤,但我想测试调用.SD如何减慢事情,如其他帖子所建议的那样(例如).

无论哪种方式,两种选择仍然是缓慢的.有什么建议可以加快速度吗？

编辑@AnandaMahto的评论

DT4 <- copy(DT1)
option3 <- function(DT){
  DT[rowSums(DT[,grep("dose",colnames(DT)),with=FALSE]) != 0]
}

> microbenchmark(op2 <- option2(DT3), op3 <- option3(DT4),times=5L)
Unit: milliseconds
               expr        min         lq    median        uq       max neval
op2 <- option2(DT3) 7738.21094 7810.87777 7838.6067 7969.5543 8407.4069     5
op3 <- option3(DT4)   83.78921   92.65472  320.6273  559.8153  783.0742     5

rowSums肯定更快.我很满意解决方案,除非有人有更快的东西.

Answer 1

我的方法如下:

使用rowSums找到你想保留的行:

Dose <- grep("dose", colnames(DT1))
# .. menas "up one level
Flag <- rowSums(is.na(DT1[, ..Dose])) != length(Dose)
DT1[Flag]