将数据框转换为存在缺失矩阵答案

【问题标题】：Convert a dataframe to presence absence matrix将数据框转换为存在缺失矩阵
【发布时间】：2014-04-29 06:47:07
【问题描述】：

我有一个表，它的字符串格式的元素数量不相等

File1 A  B  C
File2 A  B  D
File3 E  F

我想转换成如下格式

        A B C D E F
File1   1 1 1 0 0 0 
FIle2   1 1 0 1 0 0
File3   0 0 0 0 1 1

我尝试使用 reshape2 来做，但没有成功。

样本数据：

mydata <- structure(list(V1 = c("File1", "File2", "File3"), 
                         V2 = c("A", "A", "E"), V3 = c("B", "B", "F"), 
                         V4 = c("C", "D", "")), 
                   .Names = c("V1", "V2", "V3", "V4"), 
                   class = "data.frame", row.names = c(NA, -3L))

【问题讨论】：

标签： r reshape2

【解决方案1】：

一种可能性：

library(reshape2)
df2 <- melt(df, id.var = "V1")
with(df2, table(V1, value))

#         value
# V1      A B C D E F
#   File1 1 1 1 0 0 0
#   File2 1 1 0 1 0 0
#   File3 0 0 0 0 1 1

【讨论】：

【解决方案2】：

一种相当有效的方法是使用我的“splitstackshape”包中的（目前）未导出的charMat 函数。由于它没有被导出，你必须使用::: 来访问它。

library(splitstackshape)
cbind(mydata[1], splitstackshape:::charMat(
  split.default(mydata[-1], sequence(ncol(mydata)-1)), fill=0))
#      V1 V1 A B C D E F
# 1 File1  0 1 1 1 0 0 0
# 2 File2  0 1 1 0 1 0 0
# 3 File3  1 0 0 0 0 1 1

在底层，charMat 利用矩阵索引来非常高效地处理所有内容。一步一步，这就是charMat 所做的。

X <- split.default(mydata[-1], sequence(ncol(mydata)-1))
len <- length(X)
vec <- unlist(X, use.names=FALSE)
lvl <- sort(unique(vec))
out <- matrix(0L, nrow = len, ncol = length(lvl), dimnames = list(NULL, lvl))
i.idx <- rep(seq.int(len), vapply(X, length, integer(1L)))
j.idx <- match(vec, lvl)
out[cbind(i.idx, j.idx)] <- 1
out
#        A B C D E F
# [1,] 0 1 1 1 0 0 0
# [2,] 0 1 1 0 1 0 0
# [3,] 1 0 0 0 0 1 1

这看起来很拗口，但实际上是一个相当快的操作，通过使用charMat 函数变得更快:-)

更新：基准测试

以下基准测试使用我的charMat 答案测试 Henrik 的答案，并调整 Henrik 的答案以改用“data.table”，以提高效率。

运行了两个测试。第一个是在一个有 90K 行的类似数据集上，第二个是在一个有 900K 行的数据集上。

这是示例数据：

biggerdata <- do.call(rbind, replicate(30000, mydata, simplify = FALSE))
biggerdata$V1 <- make.unique(biggerdata$V1)
dim(biggerdata)
# [1] 90000     4

evenBigger <- do.call(rbind, replicate(10, biggerdata, simplify = FALSE))
evenBigger$V1 <- make.unique(evenBigger$V1)
dim(evenBigger)
# [1] 900000      4

以下是要进行基准测试的函数：

fun1 <- function(indf) {
  cbind(indf[1], splitstackshape:::charMat(
    split.default(indf[-1], sequence(ncol(indf)-1)), fill=0))
}

library(reshape2)
fun2 <- function(indf) {
  df2 <- melt(indf, id.var = "V1")
  with(df2, table(V1, value))
}

library(data.table)
library(reshape2)
DT <- data.table(biggerdata)
DT2 <- data.table(evenBigger)

fun3 <- function(inDT) {
  DTL <- melt(inDT, id.vars="V1")
  dcast.data.table(DTL, V1 ~ value, fun.aggregate=length)
}

以及基准测试的结果。

library(microbenchmark)
microbenchmark(fun1(biggerdata), fun2(biggerdata), fun3(DT), times = 20)
# Unit: milliseconds
#                        expr       min        lq    median        uq       max neval
#            fun1(biggerdata)  185.3652  199.8725  289.0206  308.5826  327.4185    20
#            fun2(biggerdata) 1453.8791 1605.6053 1639.8567 1758.3984 1797.2229    20
#  suppressMessages(fun3(DT))  469.8979  570.4664  586.4715  598.6229  675.2961    20

microbenchmark(fun1(evenBigger), fun2(evenBigger), fun3(DT2), times = 5)
# Unit: seconds
#              expr       min        lq    median        uq       max neval
#  fun1(evenBigger)  1.871611  1.896351  2.071355  2.140580  2.464569     5
#  fun2(evenBigger) 26.911523 27.212910 27.363442 27.469812 27.938178     5
#         fun3(DT2)  7.103615  7.131603  7.141908  7.205006  7.218321     5

【讨论】：