R计算单变量对多变量非方相关矩阵及两类可视化实现方法咨询

需求说明 #

• 处理300个含11个变量的数据框，单目标变量和其余10个变量做Pearson相关分析，不计算全量变量两两相关
• 输出三类结果：
  1. 含相关系数、p值、置信区间的1×10非方相关结果
  2. 1行10列分面散点图，带回归拟合线、相关系数及显著性标记
  3. 1行10列分面相关系数热力图，带相关系数及p值标记
• 要求避免全量相关矩阵计算，降低运算量

实现代码（基于内置mtcars数据集） #

依赖包加载 #

# 未安装的包可先运行 install.packages(c("tidyverse", "rstatix", "ggtext"))
library(tidyverse)
library(rstatix)
library(ggtext)

1. 非方相关矩阵计算 #

仅计算目标变量和其余变量的相关，无冗余运算：

# 以mpg为目标变量，计算与其余所有变量的Pearson相关
cor_res <- mtcars %>% 
  cor_test(mpg, method = "pearson")

# 查看计算结果
cor_res

输出结果示例：

# A tibble: 10 × 8
   var1  var2    cor statistic        p conf.low conf.high method 
   <chr> <chr> <dbl>     <dbl>    <dbl>    <dbl>     <dbl> <chr>  
 1 mpg   cyl   -0.85     -8.92 6.11e-10  -0.926     -0.716 Pearson
 2 mpg   disp  -0.85     -8.75 9.38e-10  -0.923     -0.708 Pearson
 3 mpg   hp    -0.78     -6.74 1.79e- 7  -0.885     -0.586 Pearson
 4 mpg   drat   0.68      5.10 1.78e- 5   0.436      0.832 Pearson
 5 mpg   wt    -0.87     -9.56 1.29e-10  -0.934     -0.744 Pearson
 6 mpg   qsec   0.42      2.53 1.71e- 2   0.0820     0.670 Pearson
 7 mpg   vs     0.66      4.86 3.42e- 5   0.410      0.822 Pearson
 8 mpg   am     0.6       4.11 2.85e- 4   0.318      0.784 Pearson
 9 mpg   gear   0.48      3.00 5.40e- 3   0.158      0.710 Pearson
10 mpg   carb  -0.55     -3.62 1.08e- 3  -0.755     -0.250 Pearson

2. 1行10列分面散点图绘制 #

# 数据长转换，关联相关计算结果
mtcars_long <- mtcars %>% 
  pivot_longer(cols = -mpg, names_to = "var2", values_to = "value") %>% 
  left_join(cor_res %>% select(var2, cor, p), by = "var2") %>% 
  # 生成相关系数+显著性标记文本
  mutate(cor_label = paste0("r = ", round(cor, 2), 
                            case_when(p < 0.001 ~ "***",
                                      p < 0.01 ~ "**",
                                      p < 0.05 ~ "*",
                                      TRUE ~ "")))

# 绘图
ggplot(mtcars_long, aes(x = value, y = mpg)) +
  geom_point(size = 1.2, alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE, color = "#E41A1C", linewidth = 0.8) +
  # 右上角标注相关系数
  geom_richtext(aes(label = cor_label), 
                x = Inf, y = Inf, hjust = 1.05, vjust = 1.05,
                fill = "white", label.color = NA, size = 3) +
  facet_wrap(~var2, nrow = 1, scales = "free_x") +
  labs(x = "", y = "mpg") +
  theme_bw(base_size = 10) +
  theme(strip.background = element_rect(fill = "#F0F0F0"))

3. 1行10列相关系数热力图绘制 #

# 生成标注文本
cor_res <- cor_res %>% 
  mutate(sig_mark = case_when(p < 0.001 ~ "***",
                              p < 0.01 ~ "**",
                              p < 0.05 ~ "*",
                              TRUE ~ ""),
         show_text = paste0(round(cor, 2), "\n", sig_mark))

# 绘图
ggplot(cor_res, aes(x = var2, y = 1, fill = cor)) +
  geom_tile(color = "white", linewidth = 1) +
  geom_text(aes(label = show_text), size = 3.5) +
  scale_fill_gradient2(low = "#377EB8", mid = "white", high = "#E41A1C",
                       limits = c(-1, 1), name = "Pearson相关系数") +
  scale_y_continuous(breaks = NULL) +
  labs(x = "", y = "") +
  theme_bw(base_size = 10) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "bottom",
    legend.key.width = unit(2, "cm")
  )

批量处理提示 #

针对300个数据框的场景，可将上述步骤封装为函数，用purrr::map系列函数批量循环处理所有数据框，自动输出计算结果和图表。

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