R语言计算矩阵标签交集 构建元素匹配指示矩阵

需要构造N*N的指示值矩阵：当两个样本的标签存在共有元素时，矩阵对应位置取值为1，最终得到记录两两样本标签是否匹配的数据集。原有代码运行失败，无法输出预期结果，原代码如下：

N <- 100
combinations <- c(outer(letters[1:5], letters[1:5], paste0))

set.seed(1)
data <- data.frame(
  c_1 = sample(x=combinations,size = N,replace = T),
  c_2 = sample(x=c(rep(NA,N/4),combinations),size = N,replace = T),
  c_3 = sample(x=c(rep(NA,N/2),combinations),size = N,replace = T),
  c_4 = sample(x=c(rep(NA,N/1),combinations),size = N,replace = T)) %>% 
  rowwise() %>% 
  mutate(c_all=list(c(c_1,c_2,c_3,c_4)[!is.na(c(c_1,c_2,c_3,c_4))]))

match_function <- function(x,y){
  result <- ifelse(length(intersect(x,y)),1,0)
  return(result)
}

outer(data$c_all, unlist(data$c_all)), match_function)

• 最后一行outer调用存在语法错误，多写了一个右括号，无法正常执行。
• outer函数默认要求传入的运算函数支持向量化处理，原自定义函数只能接收单个列表元素做交集运算，直接传入会导致运算逻辑不符合预期。
• outer第二个参数传入unlist(data$c_all)是错误的，该操作会把所有标签集合拆成独立的字符串向量，长度和第一个参数不匹配，无法生成N*N的矩阵。
• 生成c_all列后没有取消rowwise分组，容易导致后续运算出现意外结果。

保留原有代码的逻辑框架，仅修正错误点即可得到预期结果：

library(dplyr)

N <- 100
combinations <- c(outer(letters[1:5], letters[1:5], paste0))

set.seed(1)
data <- data.frame(
  c_1 = sample(x=combinations,size = N,replace = T),
  c_2 = sample(x=c(rep(NA,N/4),combinations),size = N,replace = T),
  c_3 = sample(x=c(rep(NA,N/2),combinations),size = N,replace = T),
  c_4 = sample(x=c(rep(NA,N/1),combinations),size = N,replace = T)) %>% 
  rowwise() %>% 
  mutate(c_all=list(c(c_1,c_2,c_3,c_4)[!is.na(c(c_1,c_2,c_3,c_4))])) %>%
  ungroup() # 取消行分组，避免后续运算异常

match_function <- function(x,y){
  as.integer(length(intersect(x,y)) > 0)
}

# 用Vectorize包装自定义函数，使其支持向量化运算，适配outer要求
match_matrix <- outer(
  X = data$c_all,
  Y = data$c_all,
  FUN = Vectorize(match_function)
)

• 最终生成的match_matrix为100*100的指示矩阵，第i行第j列值为1代表第i个样本和第j个样本存在共有标签，值为0代表无共有标签。
• 若某行所有列均为NA，对应c_all为空列表，它和所有样本的匹配值均为0，符合交集为空的逻辑。

如果需要将矩阵转换为更易分析的长表格式数据集，可以追加如下代码：

library(tidyr)
match_dataset <- match_matrix %>%
  as.data.frame() %>%
  mutate(sample_a = 1:n()) %>%
  pivot_longer(cols = -sample_a, names_to = "sample_b", values_to = "has_common_tag") %>%
  mutate(sample_b = as.integer(gsub("V", "", sample_b)))

内容的提问来源于stack exchange，提问作者MCS