数据表中应用于行：查找子集列全部为NA的行

Question

在我试图使用 data.table 包重写旧代码（缓慢）的过程中，我正在尝试找出在 data.table 中使用 apply 的最佳方法。

我的 data.table 具有多个 id 列，然后是多列剂量-反应数据，以宽格式呈现。我需要通用的答案，因为不是所有的 data.table 都会有相同数量的剂量-反应列。为了简化问题，我认为以下 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 肯定更快。如果有更快的解决方案，我会很高兴。

- dayne

---

你试过使用 rowSums 吗？ - A5C1D2H2I1M1N2O1R2T1

你可能会发现这个链接有帮助 - - TheComeOnMan

DT1[!is.na(dose1) | !is.na(dose2)] - eddi

这也可以工作，但应该是&。 - Troy

@AnandaMahto 我没有想到那个。这样会快很多。 - dayne

Answer 1

我的方法如下：

使用rowSums来找到需要保留的行：

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

- A5C1D2H2I1M1N2O1R2T1

Answer 2

DT1[!is.na(dose1) | !is.na(dose2)]

在之前的编辑中，“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

所以在100列时，Reduce仍然表现不错。

- eddi

---

这基本上是使用Reduce在R中进行循环，但其实我们可以使用向量化函数，这不是必要的。 - Arun

是的，它正在遍历列（并且对每一列进行了向量化处理）。 - eddi

我并不真正理解这是如何工作的，但它似乎比rowSums选项更快 - 请参见我的编辑。@Arun您能否举个例子说明如何去除Reduce？ - dayne

@eddi，我仍然很难理解Reduce在这里是如何工作的。您能为我澄清一下吗？ - dayne

@dayne，那是因为我在reduce表达式中犯了一个错误:) - 让我看看能否纠正它。 - eddi

Answer 3

也许更容易的方法是将所有没有NA值的行选择到一个新表中，就像这样。您可以根据您的表修改“which”条件：

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

- Troy