复杂的列表重排成矩阵

Question

抱歉标题含糊。还有，一个例子值一千字。

我有一个清单：

> lst<-list(A=c("one","two", "three"), B=c("two", "four", "five"), C=c("six", "seven"), D=c("one", "five", "eight"))

> lst
$A
[1] "one"   "two"   "three"

$B
[1] "two"  "four" "five"

$C
[1] "six"   "seven"

$D
[1] "one"   "five"  "eight"

我想重新排列成以下矩阵：

> m
      A B C D
one   1 0 0 1
two   1 1 0 0
three 1 0 0 0
four  0 1 0 0
five  0 1 0 1
six   0 0 1 0
seven 0 0 1 0
eight 0 0 0 1

其中，基本上，每个坐标代表每个列表元素中每个列表值的存在 (1) 或不存在 (0)。

我尝试弄乱 as.data.frame()、unlist()、table() 和 melt() 的各种组合，但没有成功，因此非常感谢任何正确方向的指针。

我想我最后的手段是一个嵌套循环，它遍历列表元素，然后将 0 或 1 分配给矩阵中的相应坐标，但这似乎过于复杂。

for (...) { 
    for (...) {
        if (...) {
            var <- 1
        } else {
            var <- 0
        }
    }
}

谢谢！

Answer 1

library(reshape2)

table(melt(lst))
#       L1
#value   A B C D
#  one   1 0 0 1
#  three 1 0 0 0
#  two   1 1 0 0
#  five  0 1 0 1
#  four  0 1 0 0
#  seven 0 0 1 0
#  six   0 0 1 0
#  eight 0 0 0 1

Answer 2

这是一个相当手动的方法：

t(table(rep(names(lst), sapply(lst, length)), unlist(lst)))
#        
#         A B C D
#   eight 0 0 0 1
#   five  0 1 0 1
#   four  0 1 0 0
#   one   1 0 0 1
#   seven 0 0 1 0
#   six   0 0 1 0
#   three 1 0 0 0
#   two   1 1 0 0

---

而且，stack 也有效！

table(stack(lst))
#        ind
# values  A B C D
#   eight 0 0 0 1
#   five  0 1 0 1
#   four  0 1 0 0
#   one   1 0 0 1
#   seven 0 0 1 0
#   six   0 0 1 0
#   three 1 0 0 0
#   two   1 1 0 0

---

更新 1

如果你关心行列顺序，你可以在使用table之前明确factor他们：

A <- stack(lst)
A$values <- factor(A$values, 
                   levels=c("one", "two", "three", "four", 
                            "five", "six", "seven", "eight"))
A$ind <- factor(A$ind, c("A", "B", "C", "D"))
table(A)

---

更新 2：基准测试！

因为基准测试很有趣......即使我们谈论的是微秒......去unlist！

set.seed(1)
vec <- sample(3:10, 50, replace = TRUE)
lst <- lapply(vec, function(x) sample(letters, x))
names(lst) <- paste("A", sprintf("%02d", sequence(length(lst))), sep = "")

library(reshape2)
library(microbenchmark)

R2 <- function() table(melt(lst))
S <- function() table(stack(lst))
U <- function() t(table(rep(names(lst), sapply(lst, length)), unlist(lst, use.names=FALSE)))

microbenchmark(R2(), S(), U())
# Unit: microseconds
#  expr       min        lq     median        uq       max neval
#  R2() 36836.579 37521.295 38053.9710 40213.829 45199.749   100
#   S()  1427.830  1473.210  1531.9700  1565.345  3776.860   100
#   U()   892.265   906.488   930.5575   945.326  1261.592   100