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

在我试图用

data.table

包重写旧的（慢的）代码的过程中，我试图找出用data.table使用

apply

的最佳方法

我有一个data.table，它有多个id列，然后是多个具有广泛格式的剂量反应数据的列。我需要概括一下答案，因为并非所有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

---

rowSums

绝对更快。我对这个解决方案很满意，除非有人有更快的解决方案

像这样将没有NAs的所有行选择到一个新表中可能更容易。您可以根据您的表格修改“which”条件：

DT2<-(DT1[which(!is.na(DT1$dose1) & !is.na(DT1$dose2)),])

DT2
以前编辑中的
Reduce
泛化是错误的，下面是正确的版本：

DT1[(!Reduce("*", DT1[, lapply(.SD, is.na), .SDcols = patterns("dose")]))]

基准

rowsum = function(dt) {
  Dose <- grep("dose", colnames(dt))
  Flag <- rowSums(is.na(dt[, ..Dose])) != length(Dose)
  dt[Flag]
}

reduce = function(dt) {
  dt[(!Reduce("*", dt[, lapply(.SD, is.na), .SDcols = patterns("dose")]))]
}

# original data
microbenchmark(rowsum(copy(DT1)), reduce(copy(DT1)), times = 10)
#Unit: milliseconds
#              expr      min       lq   median       uq      max neval
# rowsum(copy(DT1)) 184.4121 190.9895 238.2935 248.0654 266.5708    10
# reduce(copy(DT1)) 141.2399 172.2020 199.1012 219.4567 424.1526    10

# a lot more columns
for (i in 10:100) DT1[, paste0('dose', i) := sample(c(NA, 1:10), 1e6, T)]

microbenchmark(rowsum(copy(DT1)), reduce(copy(DT1)), times = 10)
#Unit: seconds
#              expr      min       lq   median       uq      max neval
# rowsum(copy(DT1)) 4.160035 4.428527 4.505705 4.754398 4.906849    10
# reduce(copy(DT1)) 3.421675 4.172700 4.507304 4.622355 5.156840    10

rowsum=函数（dt）{
剂量我的方法如下：

使用
rowSums
查找要保留的行：

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

您是否尝试过
行和数
？您可能会发现这很有用-
DT1[！is.na（dose1）|！is.na（dose2）]
？这也会起作用，但应该是&@AnandaMahto我没有想到。它的速度要快一点。这本质上是在R中循环（使用
Reduce
），这其实不是必需的，虽然我们可以使用向量化函数。是的，它在列上循环（并且对每列进行向量化）是的，但我们可以做得更好-对所有列进行矢量化：）。
Reduce
的伸缩性不好。我不太明白它是如何工作的，但它似乎比
rowSums
选项快-请看我的编辑。@Arun你能举个例子说明如何删除
Reduce
？只要你只有几列，它就不会不管你是否使用
Reduce
。
rowsum = function(dt) {
  Dose <- grep("dose", colnames(dt))
  Flag <- rowSums(is.na(dt[, ..Dose])) != length(Dose)
  dt[Flag]
}

reduce = function(dt) {
  dt[(!Reduce("*", dt[, lapply(.SD, is.na), .SDcols = patterns("dose")]))]
}

# original data
microbenchmark(rowsum(copy(DT1)), reduce(copy(DT1)), times = 10)
#Unit: milliseconds
#              expr      min       lq   median       uq      max neval
# rowsum(copy(DT1)) 184.4121 190.9895 238.2935 248.0654 266.5708    10
# reduce(copy(DT1)) 141.2399 172.2020 199.1012 219.4567 424.1526    10

# a lot more columns
for (i in 10:100) DT1[, paste0('dose', i) := sample(c(NA, 1:10), 1e6, T)]

microbenchmark(rowsum(copy(DT1)), reduce(copy(DT1)), times = 10)
#Unit: seconds
#              expr      min       lq   median       uq      max neval
# rowsum(copy(DT1)) 4.160035 4.428527 4.505705 4.754398 4.906849    10
# reduce(copy(DT1)) 3.421675 4.172700 4.507304 4.622355 5.156840    10

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