使用 R data.table 行的排列填充“计数矩阵”

Question

（对于以下内容，我可以使用 R data.frame 或 R data.table。两者都可以。）

我有以下data.table：

library(data.table)

dt = data.table(V1=c("dog", "dog", "cat", "cat", "cat", "bird","bird","bird","bird"), 
                    V2=rep(42, 9), V3=c(1, 2, 4, 5, 7, 1, 2, 5, 8)) 

> print(dt)
     V1 V2 V3
1:  dog 42  1
2:  dog 42  2
3:  cat 42  4
4:  cat 42  5
5:  cat 42  7
6: bird 42  1
7: bird 42  2
8: bird 42  5
9: bird 42  8

V3 列包含从 1 到 8 的整数。我的目标是在给定列 V1 中的唯一类别的情况下，使用每个组合“对”的计数填充一个 8 x 8 零矩阵

因此，dog、cat 和 bird 的组合对是：

dog: (1, 2)
cat: (4, 5), (4, 7), (5, 7)
bird: (1, 2), (1, 5), (1, 8), (2, 5), (2, 8), (5, 8)

对于每一对，我将+1 添加到零矩阵的相应条目中。对于这个矩阵，(n, m) = (m, n)。给定dt 的矩阵将是：

   1 2 3 4 5 6 7 8
1: 0 2 0 0 1 0 0 1
2: 2 0 0 0 1 0 0 1
3: 0 0 0 0 0 0 0 0
4: 0 0 0 0 1 0 1 0
5: 1 1 0 1 0 0 1 1
6: 0 0 0 0 0 0 0 0
7: 0 0 0 1 1 0 0 0
8: 1 1 0 0 1 0 0 0

请注意，(1,2)=(2,1) 的计数为 2，来自 dog 组合和 bird 组合。

(1) 给定另一列中的唯一值，是否有一种方法可以计算 R data.table/data.frame 列中的值组合？

也许输出一个带有向量“对”的 R 列表是有意义的，例如

list(c(1, 2), c(2, 1), c(4, 5), c(4, 7), c(5, 7), c(5, 4), c(7, 4), c(7, 5),
    c(1, 2), c(1, 5), c(1, 8), c(2, 5), c(2, 8), c(5, 8), c(2, 1), c(5, 1),
    c(8, 1), c(5, 2), c(8, 2), c(8, 5))

但是，我不确定如何使用它来填充矩阵...

(2) 给定输入 data.table/data.frame，如上所示，用于写出矩阵的最有效数据结构是什么？

Answer 1

不确定这是最优雅的方法，但它有效：

myfun <- function(x, matsize=8) {
    # get all (i,j) pairs but in an unfortunate text format
    pairs_all <- outer(x, x, paste)

    # "drop" all self-pairs like (1,1)
    diag(pairs_all) <- "0 0"

    # convert these text-pairs into numeric pairs and store in matrix
    ij <- do.call(rbind, lapply(strsplit(pairs_all, " "), as.numeric))

    # create "empty" matrix of zeros
    mat <- matrix(0, nrow=matsize, ncol=matsize)

    # replace each spot of empty matrix with a 1 if that pair exists
    mat[ij] <- 1

    # return 0/1 matrix
    return(mat)
}

# split your data by group
# lapply the custom function to each group
# add each group's 0/1 matrix together for final result
Reduce('+', lapply(split(dt$V3, dt$V1), myfun))

如果有人有更直接的方法来实现myfun 的前 3 行（非注释），我很乐意将它们合并。

Answer 2

这是一个似乎很有效的 data.table 解决方案。我们基本上是为了创建组合然后计数而进行自连接。然后，与 @coldspeed 对 Numpy 所做的类似，我们将仅按具有计数的位置更新零矩阵。

# a self join
tmp <- dt[dt, 
             .(V1, id = x.V3, id2 = V3), 
             on = .(V1, V3 < V3), 
             nomatch = 0L,
             allow.cartesian = TRUE
          ][, .N, by = .(id, id2)]

## Create a zero matrix and update by locations
m <- array(0L, rep(max(dt$V3), 2L))
m[cbind(tmp$id, tmp$id2)] <- tmp$N
m + t(m)

#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,]    0    2    0    0    1    0    0    1
# [2,]    2    0    0    0    1    0    0    1
# [3,]    0    0    0    0    0    0    0    0
# [4,]    0    0    0    0    1    0    1    0
# [5,]    1    1    0    1    0    0    1    1
# [6,]    0    0    0    0    0    0    0    0
# [7,]    0    0    0    1    1    0    0    0
# [8,]    1    1    0    0    1    0    0    0

---

或者，我们可以使用data.table::CJ 创建tmp，但这可能（可能 - 感谢@Frank 的提示）内存效率较低，因为它将首先创建所有可能的组合，例如

tmp <- dt[, CJ(V3, V3)[V1 < V2], by = .(g = V1)][, .N, by = .(V1, V2)]

## Then, as previously
m <- array(0L, rep(max(dt$V3), 2L))
m[cbind(tmp$V1, tmp$V2)] <- tmp$N
m + t(m)

#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,]    0    2    0    0    1    0    0    1
# [2,]    2    0    0    0    1    0    0    1
# [3,]    0    0    0    0    0    0    0    0
# [4,]    0    0    0    0    1    0    1    0
# [5,]    1    1    0    1    0    0    1    1
# [6,]    0    0    0    0    0    0    0    0
# [7,]    0    0    0    1    1    0    0    0
# [8,]    1    1    0    0    1    0    0    0