r - 应用于 data.table : find rows where a subset of columns are all NA 的行

Question

我正在尝试用 data.table 重写旧的(慢)代码包，找出最佳使用方法 apply带有数据表。

我有一个包含多个 id 列的 data.table，然后是多个具有宽格式剂量 react 数据的列。我需要概括答案，因为并非所有 data.tables 都具有相同数量的剂量 react 列。为简单起见，我认为以下 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可能会像其他帖子 ( for example ) 所建议的那样减慢速度。

无论哪种方式，这两种选择仍然处于缓慢的一面。有什么建议可以加快速度吗？

使用@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]