深度矩阵/数据框中的模式

Question

我正在尝试在具有数百万行的深度矩阵/数据帧（列：id、变量、值）中查找模式的频率。这在如下所示的宽矩阵中很容易做到。我想知道是否有办法在不首先转换为宽格式的情况下做同样的事情（在深矩阵中）。谢谢。

require(dplyr)
require(tidyr)

set.seed(100)
ncol <- 10
nrow <- 100000

#create sample matrix in wide format
df1 <- as.data.frame(matrix((runif(nrow*ncol)>0.8) + 0, ncol=ncol))
cols <- colnames(df1)
df1 <- filter(df1, rowSums(df1)>0)
df1 <- cbind(id=seq_len(nrow(df1)), df1)

#compute frequency of patterns
out1 <- df1 %>%
    group_by_(.dots=cols) %>% summarise(freq=n()) %>% as.data.frame() %>% arrange(desc(freq))

#convert to deep format
df2 <- df1 %>% 
    gather(variable, value, -id) %>% filter(value>0)

#compute frequency of patterns
out2 <- df2 %>% spread(variable, value, fill=0) %>% 
    group_by_(.dots=cols) %>% summarise(freq=n()) %>% as.data.frame() %>% arrange(desc(freq))

identical(out1, out2)

Answer 1

“宽”排列的一种可能性是将列粘贴在一起

id = do.call(paste, c(df1[, -1], sep="*"))

并列出结果

table(id)

这似乎比 dplyr 语法更简单，尽管它依赖于“技巧”而不是一般操作。其他摘要是直截了当的，例如，按列索引和计数

uid = unique(id)
data.frame(rowid=match(uid, id), count=tabulate(match(id, uid)))

或使用计数信息扩充 data.frame 的唯一版本

cbind(df1[!duplicated(id),,drop=FALSE], count = tabulate(match(id, uid)))

对于（过滤的）深度表示，我生成了数据

set.seed(100)
ncol <- 10; nrow <- 100000
m1 <- matrix((runif(nrow*ncol)>0.8) + 0, ncol=ncol)
m1 <- m1[rowSums(m1) != 0,]                         # filter
m2 <- cbind(id=as.vector(row(m1)), var=as.vector(col(m1)), val=as.vector(m1))

然后遍历每一列以计算唯一的“键”，方法是将值的（唯一索引）移动足以使键唯一

nid <- max(m2[,"id"])
nvar <- max(m2[,"var"])
key <- numeric(nid)
scale <- 1
for (i in seq_len(nvar)) {
    idx <- m2[, "var"] == i
    id <- m2[idx, "id"]
    val <- m2[idx, "val"]
    uval <- sort(unique(val))    # sort() not strictly necessary
    key[id] <- key[id] + scale * (match(val, uval) - 1L)
                                 # match() allows for non-integer 'val'
    scale <- scale * length(uval)
}

可以将键汇总到计数表中

ukey <- unique(key)
out2m <- data.frame(ukey=ukey,
                    rowid=seq_len(nid)[match(ukey, key)],
                    count=tabulate(match(key, ukey)))

并以各种方式显示

o <- order(out2m$count, decreasing=TRUE)
head(out2m[o,])
m1[out2m$rowid[head(o)],]

这比 dplyr 更快，内存效率更高，但又是一种特殊用途的算法。它还要求比例小于唯一双精度数字的最大数量，例如 2^53。

很难知道从哪里开始和结束基准测试，但由于数据可以很容易地成为数据框或矩阵，而且我们显然对计数感兴趣，因此以下可能是合理的

fdf2 <- function(df2) {
    group_by(df2, id) %>% arrange(id, variable) %>%
        summarise(pattern = toString(value)) %>%
            count(pattern)
}

fm2 <- function(m2) {
    nid <- max(m2[,"id"])
    nvar <- max(m2[,"var"])
    key <- numeric(nid)
    scale <- 1
    for (i in seq_len(nvar)) {
        idx <- m2[, "var"] == i
        id <- m2[idx, "id"]
        val <- m2[idx, "val"]
        uval <- sort(unique(val))
        key[id] <- key[id] + scale * (match(val, uval) - 1L)
        scale <- scale * length(uval)
    }

    ukey <- unique(key)
    data.frame(ukey=ukey, rowid=seq_len(nid)[match(ukey, key)],
               count=tabulate(match(key, ukey)))
}

不需要microbenchmark 或类似的，

> system.time(fdf2(df2))
   user  system elapsed 
  4.640   0.000   4.639 
> system.time(fm2(m2))
   user  system elapsed 
  0.587   0.000   0.587 

可能是模拟数据不真实，或者算法规模不同，并且其中一个或另一个比真实数据更具竞争力；最初提出的问题措辞不够清楚，无法进行更相关的测试。

内存使用在 R 中更难衡量；我猜 fm2 只需要内存来保存 nvar * 3 元素，例如，如果所有双打

> print(object.size(double(nid)) * 3, units="auto")
2 Mb

我猜 dplyr 很聪明，所以很难推理，但是一些中间对象很大，例如，

> print(object.size(group_by(df2, id)), units="auto")
22.5 Mb

我实际上并不确定如何轻松地严格描述内存使用，特别是因为 dplyr 调用 C 代码并且很可能使用非 R 内存。

Answer 2

（评论太长）

我怀疑这是可能的（虽然不能肯定地说）。

两个挑战：

• 在长格式中，每个唯一的“模式”至少分布在ncol 行上。您将如何使用“总结”并将其分解为一行（它只能保存一个值，这意味着它是一个不完整的模式）？
• 我在您的示例代码中看到的第二个问题：当您创建 df2 和 使用filter(value > 0)你有效地破坏了大部分现有的 模式，因为绝大多数模式（宽格式） 在某些行中包含 0。您仍然可以使用的唯一 complete 模式 观察那么可能只包含 1，对吧？

更准确地说：这可能是可能的，但我相信它需要比从长到宽的转换更大的解决方法。

---

我只是改变了主意，但我不确定这与从长格式到宽格式的转换是否真的有很大不同：

out2 <- group_by(df2, id) %>% arrange(id, variable) %>%
          summarise(pattern = toString(value)) %>%
           count(pattern)

结果：

> out2 %>% arrange(desc(n))
Source: local data frame [896 x 2]

                        pattern    n
1  0, 0, 0, 0, 0, 0, 0, 1, 0, 0 2794
2  0, 0, 1, 0, 0, 0, 0, 0, 0, 0 2754
3  0, 0, 0, 0, 0, 0, 0, 0, 0, 1 2742
4  0, 0, 0, 0, 0, 0, 0, 0, 1, 0 2716
5  0, 0, 0, 0, 0, 1, 0, 0, 0, 0 2716
6  1, 0, 0, 0, 0, 0, 0, 0, 0, 0 2710
7  0, 1, 0, 0, 0, 0, 0, 0, 0, 0 2685
8  0, 0, 0, 1, 0, 0, 0, 0, 0, 0 2633
9  0, 0, 0, 0, 1, 0, 0, 0, 0, 0 2630
10 0, 0, 0, 0, 0, 0, 1, 0, 0, 0 2618
..                          ...  ...

为了与其他数据进行比较并生成df2，我使用：

set.seed(100)
ncol <- 10
nrow <- 100000

#create sample matrix in wide format
df1 <- as.data.frame(matrix((runif(nrow*ncol)>0.8) + 0, ncol=ncol))
cols <- colnames(df1)
df1 <- filter(df1, rowSums(df1)>0)
df1 <- cbind(id=seq_len(nrow(df1)), df1)

#compute frequency of patterns
out1 <- df1 %>%
    group_by_(.dots=cols) %>% summarise(freq=n()) %>% as.data.frame() %>% arrange(desc(freq))

#convert to deep format
df2 <- df1 %>%                      # this is the input for my code
    gather(variable, value, -id)    # note that I don't use `filter(value>0)` here!

与 out1 比较：

> head(out1[order(-out1$freq),])
  V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 freq
1  0  0  0  0  0  0  0  1  0   0 2794
2  0  0  1  0  0  0  0  0  0   0 2754
3  0  0  0  0  0  0  0  0  0   1 2742
4  0  0  0  0  0  0  0  0  1   0 2716
5  0  0  0  0  0  1  0  0  0   0 2716
6  1  0  0  0  0  0  0  0  0   0 2710

显然，我不能在这里使用identical(out1, out2)，因为out2 只有2 列.. 但我可以在频率计数上使用它：

identical(out1$freq, out2$n)
#[1] TRUE

.. 如果你想将 out2 转换为与 out1 相同的东西，你可以使用来自 tidyr 的separate：

separate(out2, col = pattern, into = paste0("V", seq_len(ncol)), sep = ",")