如何从 data.table 构造外部产品矩阵

Question

我不知道如何解决这个问题，我唯一能想到的就是暴力循环，但我什至不确定如何以合理的方式循环遍历 data.table 的行。

我有一个双键 data.table 和一个基于第一个键的相关矩阵。我需要通过查找任何给定对的相关性来为所有元素构建完整的相关矩阵，如果第二个键不匹配，则该矩阵为零。

简化示例：

library(data.table)
DT = data.table(Key1 = c("A", "A", "A", "B", "B", "C", "C"), Key2 = c(1,2,3,2,3,3,4), OtherData = "Irrelevant")
setkey(DT, Key2, Key1)
M = matrix(c(1.0, 0.4, 0.3, 
             0.4, 1.0, 0.2, 
             0.3, 0.2, 1.0), nrow = 3)

所以我们的起始 data.table 看起来像：

> DT
   Key1 Key2  OtherData
1:    A    1 Irrelevant
2:    A    2 Irrelevant
3:    B    2 Irrelevant
4:    A    3 Irrelevant
5:    B    3 Irrelevant
6:    C    3 Irrelevant
7:    C    4 Irrelevant

当 A、B 和 C 共享相同的 Key2 值时，它们的预定义相关矩阵由 M 给出：

> M
     [,1] [,2] [,3]
[1,]  1.0  0.4  0.3
[2,]  0.4  1.0  0.2
[3,]  0.3  0.2  1.0

我现在需要制作一个 7x7 矩阵，如下所示：

> result
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]  1.0    0    0    0    0    0    0
[2,]    0  1.0  0.4    0    0    0    0
[3,]    0  0.4  1.0    0    0    0    0
[4,]    0    0    0  1.0  0.4  0.3    0
[5,]    0    0    0  0.4  1.0  0.2    0
[6,]    0    0    0  0.3  0.2  1.0    0
[7,]    0    0    0    0    0    0  1.0

我们使用 M 中与每个 Key2 上可用的 Key1 值匹配的部分创建了块对角矩阵（Key2 是有效的时间）。

Answer 1

这是一种方式（但不确定它是如何扩展的）：

rownames(M) <- colnames(M) <- LETTERS[1:3]
ans <- DT[, list(idx1=.I, idx2=rep(.I, each=.N), 
            val=as.vector(M[Key1, Key1])), by=Key2]
dcast.data.table(ans, idx2 ~ idx1, value.var="val", fill=0L)

#    idx2 1   2   3   4   5   6 7
# 1:    1 1 0.0 0.0 0.0 0.0 0.0 0
# 2:    2 0 1.0 0.4 0.0 0.0 0.0 0
# 3:    3 0 0.4 1.0 0.0 0.0 0.0 0
# 4:    4 0 0.0 0.0 1.0 0.4 0.3 0
# 5:    5 0 0.0 0.0 0.4 1.0 0.2 0
# 6:    6 0 0.0 0.0 0.3 0.2 1.0 0
# 7:    7 0 0.0 0.0 0.0 0.0 0.0 1

dcast.data.table 可从 data.table 版本>= 1.9.0 获得。在撰写本文时，当前稳定的 CRAN 版本是 1.9.2。

Answer 2

这就是你想要的：

1.设置数据。

DT <- data.frame(Key1 = c("A", "A", "B", "A", "B", "C", "C"), Key2 = c(1, 2, 2, 3, 3, 3, 4))

M <- matrix(c(1, 0.4, 0.3, 0.4, 1, 0.2, 0.3, 0.2, 1), nrow = 3)

2.对矩阵进行子集化，按 Key2 分组（这将返回一个列表）。

BD <- by(DT, DT$Key2, function(df) {N = as.numeric(df$Key1); M[N,N]})

3.构造块对角矩阵。

library(magic)

do.call(adiag, BD)

Answer 3

我的data.table 技能不是那么强，但我想出了一个利用索引的解决方案，但前提是我添加了行号。

# DT$row<-1:nrow(DT) # No longer necessary.
# Add dimension names to matrix for convenience
rownames(M)<-colnames(M)<-c('A','B','C') 

f<-function(k1,k2) {
  # rows<-DT[.(k2)]$row 
  rows<-DT[.(k2),.I]$.I
  ret<-rep(0,nrow(DT))
  ret[rows]<-M[DT[.(k2)]$Key1,k1]
  ret
}

mapply(f,DT$Key1,DT$Key2)
#      A   A   B   A   B   C C
# [1,] 1 0.0 0.0 0.0 0.0 0.0 0
# [2,] 0 1.0 0.4 0.0 0.0 0.0 0
# [3,] 0 0.4 1.0 0.0 0.0 0.0 0
# [4,] 0 0.0 0.0 1.0 0.4 0.3 0
# [5,] 0 0.0 0.0 0.4 1.0 0.2 0
# [6,] 0 0.0 0.0 0.3 0.2 1.0 0
# [7,] 0 0.0 0.0 0.0 0.0 0.0 1

从调用索引的意义上来说，这应该会好一些。更有效的解决方案可能会利用输出矩阵的已知对角线性质。 不知道有没有办法在不添加行号的情况下做到这一点？下面的评论指出了一种获取行号的方法，我已经在上面实现了。

Answer 4

已编辑为使用原生 data.table() 功能 - 希望它应该表现更好！

# make the cor matrix into an expand.grid equivalent - all combos - using CJ for cross join
cor_list<-data.table(CJ(LETTERS[1:nrow(M)],LETTERS[1:nrow(M)]))
# fill with the values for M
cor_list[,cor:=unlist(as.list(M))]
# index on combination of correlation inputs
setkey(cor_list, V1, V2)

# lookup correlation for all combos of DT v DT
DTX<-DT[,cor_list[J(Key1,DT[,Key1],DT[,Key2])],by=c("Key1","Key2")]
# index on Key2
setkey(DTX,Key2)
# Set cor=0 where Key2 doesn't match (OK, it's a bit of a hack!)
DTX[Key2!=V3,cor:=0]

# fill a matrix with the vector of correlations (it fits)
# original length of DT gives you the length of side 
matrix(DTX[,cor],nrow(DT))

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    1  0.0  0.0  0.0  0.0  0.0    0
[2,]    0  1.0  0.4  0.0  0.0  0.0    0
[3,]    0  0.4  1.0  0.0  0.0  0.0    0
[4,]    0  0.0  0.0  1.0  0.4  0.3    0
[5,]    0  0.0  0.0  0.4  1.0  0.2    0
[6,]    0  0.0  0.0  0.3  0.2  1.0    0
[7,]    0  0.0  0.0  0.0  0.0  0.0    1

以上编辑 - 根据 ROLAND 的评论加倍申请缓慢

这个怎么样？

#function to return letter corresponding to number
lookup_letter<-function(let){match(let,matrix(c("A","B","C")))}

然后为矩阵的每个维度嵌套 2 次应用调用

apply(DT,1,function(x){                # call row-wise
  apply(DT,1,function(y)ifelse(y[2]==x[2],M[lookup_letter(x[1]),lookup_letter(y[1])],0))   # call column-wise lookup
  })

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    1  0.0  0.0  0.0  0.0  0.0    0
[2,]    0  1.0  0.4  0.0  0.0  0.0    0
[3,]    0  0.4  1.0  0.0  0.0  0.0    0
[4,]    0  0.0  0.0  1.0  0.4  0.3    0
[5,]    0  0.0  0.0  0.4  1.0  0.2    0
[6,]    0  0.0  0.0  0.3  0.2  1.0    0
[7,]    0  0.0  0.0  0.0  0.0  0.0    1

可能有更好的方法来查找您的相关数，但这会给您一个想法（也许将 M 展平为索引列表）