R - 比较两个分层列表之间的公共(public)元素的循环

Question

一段时间以来，我一直在尝试构建一个由两个分层列表之间的共同元素计数填充的矩阵。

这是一些虚拟数据:

site<-c('A','A','A','A','A','A','A','A','A','B','B','B','B','B','B')
group<-c('A1','A1','A2','A2','A2','A3','A3','A3','A3', 
'B1','B1','B2','B2','B2','B2')
element<-c("red","orange","blue","black","white", "black","cream","yellow","purple","red","orange","blue","white","gray","salmon")
d<-cbind(site,group,element)

我创建了一个列表结构，假设由于每个列表中的 os 元素数量不同，它是程序化的。另外，因为我不想在组之间进行所有可能的比较，而只是在站点之间进行比较。

#first level list - by site
sitelist<-split(nodmod, list(nodmod$site),drop = TRUE)
#list by group 
nestedlist <- lapply(sitelist, function(x) split(x, x[['mod']], drop = TRUE))

我的目的是创建一个表或矩阵，其中包含两个站点的组之间的共同元素数(我的原始数据有其他站点)。像这样:

    A1  A2  A3
B1  2   0   0
B2  0   2   0

这个问题的嵌套性质对我来说很有挑战性。我对列表不太熟悉，因为我主要使用数据框解决问题。我的尝试归结为这一点。我觉得它接近了，但是对于循环的正确语法还有很多缺点。

t <- outer(1:length(d$A),
         1:length(d$B),
         FUN=function(i,j){
           sapply(1:length(i),
                  FUN=function(x) 
                    length(intersect(d$A[[i]]$element, d$B[[j]]$element)) )
         })

任何帮助将不胜感激。如果解决了类似的问题，我们深表歉意。我已经在互联网上搜索过，但没有找到它，或者没有理解使其可以转移到我的解决方案。

Answer 1

考虑矩阵乘法 x %*% y(参见 ?matmult)，方法是通过独特的 元素 值的辅助矩阵>group 在每个相应的单元格中分配值。然后运行矩阵乘法作为自身的转置，然后是行和列的子集:

# EMPTY MATRIX
helper_mat <- matrix(0, nrow=length(unique(element)), ncol=length(unique(group)),
                     dimnames=list(unique(element), unique(group)))

# ASSIGN 1's AT SELECT LOCATIONS
for(i in seq_along(site)) {
  helper_mat[element[i], group[i]] <- 1
}

helper_mat
#        A1 A2 A3 B1 B2
# red     1  0  0  1  0
# orange  1  0  0  1  0
# blue    0  1  0  0  1
# black   0  1  1  0  0
# white   0  1  0  0  1
# cream   0  0  1  0  0
# yellow  0  0  1  0  0
# purple  0  0  1  0  0
# gray    0  0  0  0  1
# salmon  0  0  0  0  1

# MATRIX MULTIPLICATION WITH SUBSET
final_mat <- t(helper_mat) %*% helper_mat
final_mat <- final_mat[grep("B", rownames(final_mat)), grep("A", colnames(final_mat))]

final_mat
#    A1 A2 A3
# B1  2  0  0
# B2  0  2  0

---

由于@Lamia，版本更短:

helper_mat <- table(element, group)

final_mat <- t(helper_mat) %*% helper_mat # ALTERNATIVELY: crossprod(helper_mat)

final_mat <- final_mat[grep("B", rownames(final_mat)), grep("A", colnames(final_mat))]

final_mat
#      group
# group A1 A2 A3
#    B1  2  0  0
#    B2  0  2  0