如何使用data.table将表应用于多个列？

Question

假设我有一个data.table

prueba <- data.table(aa=1:7,
                     bb=c(1,2,NA,NA,3,1,1),
                     cc=c(1,2,NA,NA,3,1,1),
                   YEAR=c(1,1,1,2,2,2,2))

我想从给定的集合中得到每一列的缺失表，例如aa、bb和cc。

结果应该是这样：

aa bb cc 1: 0 2 2 0: 7 0 0

或者它的转位形式或者其他标签。

我试过了

prueba[,lapply(.SD, function(x) as.list(  table(
       factor(is.na(x), levels=c("0","1"))))),
       .SDcols=c("aa","bb", "cc")]

但我得到的却是：

aa bb cc 1: 7 5 5 0: 7 2 2

我认为这与桌子下降了未使用的水平有关。但我尝试过用xtabs和各种黑客攻击，但都没有成功。

我可以得到一些丑陋的东西

sapply(c("aa","bb","cc"), function(x) prueba[,as.list(
      table(is.na(get(x))))])

Answer 1

也许使用table

prueba[, table(is.na(.SD), names(.SD)[col(.SD)]), .SDcols=aa:cc]

        aa bb cc
  FALSE  7  5  5
  TRUE   0  2  2

这实质上是把它当作一个矩阵。

一些替代办法：

prueba[, table(is.na(.SD), rep(names(.SD), each=.N)), .SDcols=aa:cc]

melt(prueba[, aa:cc])[, table(is.na(value), variable)]

Answer 2

下面是R基的一种方法：

rbind(tmp <- colSums(is.na(prueba[ , -"YEAR"])), nrow(prueba) - tmp)
#      aa bb cc
# [1,]  0  2  2
# [2,]  7  5  5

Answer 3

这是另一个应该足够笼统的建议。首先，根据需求构建应急表。接下来，将表输出转换为一个列表和rbindlist所有结果。最后，将NA替换为0计数。

output <- prueba[, rbindlist(
        lapply(.SD, function(x) as.list(table(is.na(x)))), 
        fill=TRUE, 
        idcol=TRUE), 
    .SDcols=aa:cc]

output[, lapply(.SD, function(x) replace(x, is.na(x), 0L))]

产出：

   .id FALSE TRUE
1:  aa     7    0
2:  bb     5    2
3:  cc     5    2

编辑:添加另一个通用方法：

#build and flatten contingency table
tab <- prueba[, as.list(unlist(lapply(.SD, function(x) table(is.na(x))))),
    .SDcols=aa:cc]

#melt, split original column names and then pivot
dcast(
    melt(tab, measure.vars=names(tab))[, 
        c("V1","Factor") := tstrsplit(variable, split="\\.")],
    Factor ~ V1, 
    function(x) x[1L], 
    fill=0L) 

产出：

   Factor aa bb cc
1:  FALSE  7  5  5
2:   TRUE  0  2  2

编辑:添加时间

set.seed(0L)
sz <- 1e6
nc <- 10
DT <- as.data.table(matrix(sample(c(NA_integer_, 1L:10L), sz*nc, TRUE), ncol=nc))
setnames(DT, paste0("C", 1L:nc))
cols <- names(DT)

mtd1 <- function() {
    DT[, table(is.na(.SD), names(.SD)[col(.SD)]), .SDcols=cols]
}

mtd2 <- function() {
    DT[, table(is.na(.SD), rep(names(.SD), each=.N)), .SDcols=cols]
}

mtd3 <- function() {
    melt(DT[, ..cols], measure.vars=cols)[, table(is.na(value), variable)]
}

mtd4 <- function() {
    tab <- DT[, as.list(unlist(lapply(.SD, function(x) table(is.na(x))))),
        .SDcols=cols]

    dcast(melt(tab, measure.vars=names(tab))[, c("V1","Factor") := tstrsplit(variable, split="\\.")],
        Factor ~ V1, function(x) x[1L], fill=0L)
}

mtd5 <- function() {
    output <- DT[, rbindlist(lapply(.SD, function(x) as.list(table(is.na(x)))), fill=TRUE, idcol=TRUE),
        .SDcols=cols]

    output[, lapply(.SD, function(x) replace(x, is.na(x), 0L))]
}

library(microbenchmark)
microbenchmark(mtd1(), mtd2(), mtd3(), mtd4(), mtd5(), times=3L)

计时：

Unit: seconds
   expr      min       lq     mean   median       uq      max neval cld
 mtd1() 5.044369 5.049252 5.086534 5.054135 5.107617 5.161100     3   b
 mtd2() 5.106796 5.110014 5.474269 5.113232 5.658005 6.202778     3   b
 mtd3() 2.395127 2.461463 2.509938 2.527799 2.567344 2.606888     3  a 
 mtd4() 2.138672 2.142300 2.145895 2.145927 2.149506 2.153084     3  a 
 mtd5() 2.113367 2.175346 2.228162 2.237325 2.285560 2.333794     3  a