如何制作适配Word的带显著性星号的发表级相关矩阵

方案一：基于psych + flextable优化实现 #

针对现有代码的不足，补充变量名列、添加显著性星号的完整代码如下：

library(flextable)
library(psych)
library(dplyr)

# 创建数据框
var1 <- c(2,3,1,5,4,5)
var2 <- c(23,25,21,31,67,43)
var3 <- c(2,5,98,4,3,54)
df <- data.frame(var1,var2,var3)

# 计算相关系数与对应p值
df.corr <- psych::corr.test(df, adjust = "none")
corr_r <- as.data.frame(df.corr$r)
corr_p <- as.data.frame(df.corr$p)

# 定义显著性星号规则：*p<0.05, **p<0.01, ***p<0.001
add_stars <- function(p_val) {
  case_when(
    p_val < 0.001 ~ "***",
    p_val < 0.01 ~ "**",
    p_val < 0.05 ~ "*",
    TRUE ~ ""
  )
}

# 为每个p值生成星号，并与相关系数合并
corr_with_stars <- mapply(
  function(r, star) paste0(round(r, 2), star),
  corr_r,
  apply(corr_p, c(1,2), add_stars)
) %>% as.data.frame()

# 添加变量名列（将原行名转为第一列）
corr_with_stars$变量名 <- rownames(corr_with_stars)
corr_with_stars <- corr_with_stars[, c(ncol(corr_with_stars), 1:(ncol(corr_with_stars)-1))]

# 生成可导出Word的表格
ft_final <- flextable(corr_with_stars) %>%
  set_header_labels(变量名 = "") %>% # 隐藏第一列标题
  align(align = "center", part = "all") %>%
  autofit()

# 导出到Word文档
save_as_docx(ft_final, path = "带星号相关矩阵.docx")

方案二：基于gtsummary快速实现 #

gtsummary的tbl_cor()函数可一键生成符合发表规范的相关矩阵，自动处理变量名、显著性星号，操作更简洁：

library(gtsummary)
library(flextable)

# 创建数据框
var1 <- c(2,3,1,5,4,5)
var2 <- c(23,25,21,31,67,43)
var3 <- c(2,5,98,4,3,54)
df <- data.frame(var1,var2,var3)

# 生成带星号的相关矩阵
corr_table <- df %>%
  tbl_cor(
    method = "pearson", # 可选spearman等其他相关方法
    stars = TRUE, # 启用显著性星号
    show_p = FALSE # 若不需要显示p值，设为FALSE即可
  ) %>%
  modify_header(label = "") %>% # 隐藏第一列标题
  as_flex_table() # 转换为flextable格式，支持导出Word

# 导出到Word
save_as_docx(corr_table, path = "相关矩阵_gtsummary版.docx")

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