如何在R中按行名匹配计算两个data.frame列间的Spearman相关？

需求描述 #

有两个带缺失值的DataFrame（df1和df2），二者行名为随机抽取的不重复字母且行数不同。需要系统计算df1每一列与df2每一列之间的Spearman相关系数及p值，仅匹配相同行名的样本，最终生成包含列对、相关系数和p值的结果DataFrame。

数据示例代码 #

set.seed(12345)
df1 <- data.frame(a=rnorm(20,0,0.4),
                  b=rnorm(20,0.3,0.8),
                  c=rnorm(20,-0.1,0.6),
                  d=rnorm(20,-0.23,0.3),
                  e=rnorm(20,0.2,0.4))
library(purrr)
df1 <- as.data.frame(map_df(df1, function(x) {x[sample(c(TRUE, NA), prob = c(0.8, 0.2), 
     size = length(x), replace = TRUE)]}))
rownames(df1) <- sample(LETTERS, 20, replace=FALSE)
df2 <- data.frame(one=rnorm(23,6,2),
                  two=rnorm(23,8,4),
                  three=rnorm(23,12,5),
                  four=rnorm(23,4,0.4),
                  five=rnorm(23,3,0.2))
df2 <- as.data.frame(map_df(df2, function(x) {x[sample(c(TRUE, NA), prob = c(0.7, 0.3), 
     size = length(x), replace = TRUE)]}))
rownames(df2) <- sample(LETTERS, 23, replace=FALSE)

原代码问题 #

原代码未匹配行名，直接按行索引过滤缺失值，导致df1和df2中不同行名的样本被错误配对：

library(dplyr)
df3 <- data.frame(letter = character(),
                   number = character(),
                   Spearman.r = numeric(),
                   p.value = numeric(),
                   stringsAsFactors = FALSE)
for (col1 in colnames(df1)) {
  for (col2 in colnames(df2)) {
    valid_rows <- !is.na(df1[[col1]]) & !is.na(df2[[col2]])
    x <- df1[[col1]][valid_rows]
    y <- df2[[col2]][valid_rows]
    if (length(x) > 1 & length(y) > 1) {
      result <- cor.test(x, y, method = "spearman")
      df3 <- df3 %>%
        add_row(letter = col1,
                number = col2,
                Spearman.r = result$estimate,
                p.value = result$p.value)
    }
  }
}

修正后的代码 #

核心是先获取两个DataFrame的共同行名，再基于共同行名提取样本并计算：

library(dplyr)

# 获取两个数据集的共同行名，确保样本匹配
common_rownames <- intersect(rownames(df1), rownames(df2))

# 初始化结果数据框
df3 <- data.frame(
  letter = character(),
  number = character(),
  Spearman.r = numeric(),
  p.value = numeric(),
  stringsAsFactors = FALSE
)

for (col1 in colnames(df1)) {
  for (col2 in colnames(df2)) {
    # 提取共同行名对应的子集
    x_subset <- df1[common_rownames, col1]
    y_subset <- df2[common_rownames, col2]
    
    # 过滤掉包含缺失值的样本
    valid_idx <- !is.na(x_subset) & !is.na(y_subset)
    x <- x_subset[valid_idx]
    y <- y_subset[valid_idx]
    
    # 仅当有效样本数≥2时计算相关系数
    if (length(x) >= 2) {
      # exact=FALSE避免样本量小且有重复值时的警告，可根据需求调整
      result <- cor.test(x, y, method = "spearman", exact = FALSE)
      df3 <- df3 %>%
        add_row(
          letter = col1,
          number = col2,
          Spearman.r = round(result$estimate, 4),
          p.value = round(result$p.value, 4)
        )
    } else {
      # 样本不足时填充NA，也可选择跳过该列对
      df3 <- df3 %>%
        add_row(
          letter = col1,
          number = col2,
          Spearman.r = NA,
          p.value = NA
        )
    }
  }
}

关键修正点 #

• 匹配行名：用intersect()获取共同行名，确保计算时仅使用两个数据集中都存在的样本
• 子集提取：基于共同行名提取列数据，保证x和y对应的是同一个样本
• 缺失值处理：先取共同行名子集，再过滤缺失值，避免跨数据集的行索引错误配对
• 边界处理：添加有效样本数判断，避免cor.test因样本不足报错；同时处理样本不足的情况（填充NA）

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