如何生成仅聚焦VOC且保留显著性星号的相关分析矩阵

问题背景 #

已生成带显著性星号标记的完整相关矩阵，需要调整输出，仅保留VOC变量对应的相关系数列，同时保留显著性标记。

现有输出 #

Greet    Connect  Shop     Membership  Solve    Recap&Re-Engage  Average  VOC     
Greet           "1.0   " "0.4***" "0.3***" "0.1***"    "0.2***" "0.0*  "         "0.5***" "0.1***"
Connect         "0.4***" "1.0   " "0.4***" "0.2***"    "0.4***" "0.3***"         "0.8***" "0.4***"
Shop            "0.3***" "0.4***" "1.0   " "0.3***"    "0.2***" "0.2***"         "0.7***" "0.2***"
Membership      "0.1***" "0.2***" "0.3***" "1.0   "    "0.2***" "0.2***"         "0.5***" "0.2***"
Solve           "0.2***" "0.4***" "0.2***" "0.2***"    "1.0   " "0.4***"         "0.6***" "0.4***"
Recap&Re-Engage "0.0*  " "0.3***" "0.2***" "0.2***"    "0.4***" "1.0   "         "0.5***" "0.2***"
Average         "0.5***" "0.8***" "0.7***" "0.5***"    "0.6***" "0.5***"         "1.0   " "0.4***"
VOC             "0.1***" "0.4***" "0.2***" "0.2***"    "0.4***" "0.2***"         "0.4***" "1.0   "

期望输出 #

Voc
Greet.      0.1***
Connect.    0.4***
Shop.       0.2***
Membership. 0.2***
Solve       0.4***
Recap       0.2***
Average     0.4***
VOC         1.0

解决方案 #

提供两种实现方式，按需选择：

方式1：调用原函数后提取VOC列 #

无需修改原函数，生成完整矩阵后直接筛选目标列：

# 生成完整相关矩阵
full_cor_matrix <- correlation_matrix(QA_Behav_Overall)

# 提取VOC列（注意原函数给列名添加了空格，所以列名为"VOC "）
voc_cor <- full_cor_matrix[, "VOC "]

# 转换为数据框并调整格式
voc_result <- data.frame(VOC = voc_cor, check.names = FALSE)

# 可选：调整行名（将"Recap&Re-Engage"简化为"Recap"）
rownames(voc_result) <- gsub("&Re-Engage", "", rownames(voc_result))

# 打印结果（去掉引号）
print(voc_result, quote = FALSE)

方式2：修改原函数，添加聚焦列参数 #

如果希望函数直接输出目标列，可修改函数新增focus_col参数，同时修复原函数中rcorr调用的参数错误：

correlation_matrix <- function(QA_Behav_Overall, 
                               type = "pearson",
                               digits = 1, 
                               decimal.mark = ".",
                               use = "all", 
                               show_significance = TRUE, 
                               replace_diagonal = FALSE, 
                               replacement = "",
                               focus_col = NULL){  # 新增聚焦列参数
  
  # 参数校验
  stopifnot({
    is.numeric(digits)
    digits >= 0
    use %in% c("all", "upper", "lower")
    is.logical(replace_diagonal)
    is.logical(show_significance)
    is.character(replacement)
    is.null(focus_col) || focus_col %in% colnames(QA_Behav_Overall)
  })
  
  require(Hmisc)
  
  # 保留数值/布尔型列
  isNumericOrBoolean <- vapply(QA_Behav_Overall, function(x) is.numeric(x) | is.logical(x), logical(1))
  if (sum(!isNumericOrBoolean) > 0) {
    cat('Dropping non-numeric/-boolean column(s):', paste(names(isNumericOrBoolean)[!isNumericOrBoolean], collapse = ', '), '\n\n')
  }
  QA_Behav_Overall <- QA_Behav_Overall[isNumericOrBoolean]
  
  x <- as.matrix(QA_Behav_Overall)
  
  # 修复原函数的参数错误：补充type参数
  correlation_matrix <- Hmisc::rcorr(x, type = type)
  R <- correlation_matrix$r 
  p <- correlation_matrix$P 
  
  # 格式化相关系数
  Rformatted <- formatC(R, format = 'f', digits = digits, decimal.mark = decimal.mark)
  
  # 对齐正负数值
  if (sum(R < 0) > 0) {
    Rformatted <- ifelse(R > 0, paste0(' ', Rformatted), Rformatted)
  }
  
  # 添加显著性星号
  if (show_significance) {
    stars <- ifelse(is.na(p), "   ", ifelse(p < .001, "***", ifelse(p < .01, "** ", ifelse(p < .05, "*  ", "   "))))
    Rformatted <- paste0(Rformatted, stars)
  }
  
  # 构建结果矩阵
  Rnew <- matrix(Rformatted, ncol = ncol(x))
  rownames(Rnew) <- colnames(x)
  colnames(Rnew) <- paste(colnames(x), "", sep =" ")
  
  # 处理上/下三角或对角线替换
  if (use == 'upper') {
    Rnew[lower.tri(Rnew, diag = replace_diagonal)] <- replacement
  } else if (use == 'lower') {
    Rnew[upper.tri(Rnew, diag = replace_diagonal)] <- replacement
  } else if (replace_diagonal) {
    diag(Rnew) <- replacement
  }
  
  # 新增：如果指定聚焦列，仅保留该列并调整行名
  if (!is.null(focus_col)) {
    target_col <- paste(focus_col, "", sep = " ")
    Rnew <- Rnew[, target_col, drop = FALSE]
    rownames(Rnew) <- gsub("&Re-Engage", "", rownames(Rnew))
  }
  
  return(Rnew)
}

# 调用时指定聚焦VOC列
correlation_matrix(QA_Behav_Overall, focus_col = "VOC")

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