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如何减慢其他帖子所建议的速度（{{3} }）。

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

编辑@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))
Flag <- rowSums(is.na(DT1[, Dose, with = FALSE])) != length(Dose)
DT1[Flag]

Answer 2

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

以前编辑中的Reduce概括是错误的，这是正确的版本：

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

<强>基准

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

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

# 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仍然可以做到。

Answer 3

可能更容易只选择没有NA的所有行进入这样的新表。您可以根据您的表格修改“哪个”条件：

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

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

3 个答案: