代码之家 › 专栏 › 技术社区 › skan

如何将表应用于具有data.table的多个列?

data.table r

skan · 技术社区 · 7 年前

假设我有一个数据表。

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))

我想从一个给定的集合中得到每列的遗漏表,例如a a、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))))])

4 回复 | 直到 7 年前

Frank 7 年前

也许用 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)]

Sven Hohenstein 7 年前

下面是一个基于r的方法:

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

chinsoon12 7 年前

这是另一个足够笼统的建议。首先,根据需要建立应急表。接下来,将表输出转换为列表并 rbindlist 所有结果都在一起。最后,用0计数替换NA。

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

skan 7 年前

好吧,我找到了一个解决方案,有点复杂:

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

应该有一个更简单的方法。