前言

相关系数图是对相关系数矩阵进行可视化的，用于展示多组变量之间的相关性。

根据数据的分布特征，可以应用不同的相关系数计算方法，如 pearson、spearman、Kendall 等

相关系数矩阵的可视化图形，可以是热图、气泡图、方块图、椭圆图，也可以是纯数字文本形式，等等。

下面我们介绍它们的绘制方法

示例

我们首先使用 ggplot2 包提供的函数来绘制这些图形

先计算相关系数矩阵

mat <- as.data.frame(round(cor(mtcars), 2))
mat$var1 <- rownames(mat)
data <- gather(mat, key = "var2", value = "corr", -var1)

1. 热图

library(RColorBrewer)
# 获取 5 个颜色
my_color <- brewer.pal(5, "Spectral")

ggplot(data, aes(var1, var2, fill = corr)) +
  geom_tile(colour = "black") +
  scale_fill_gradientn(colours = my_color)

2. 气泡图

ggplot(data, aes(var1, var2, fill = corr)) +
  geom_point(aes(size = abs(corr)), shape = 21, colour = "black") +
  scale_fill_gradientn(colours = my_color) +
  scale_size_area(max_size = 15, guide = FALSE)

3. 方块图

只要设置参数 shape = 22，就可以换成方块了

geom_point(aes(size = abs(corr)), shape = 22, colour = "black") 

4. 设置标签

使用 geom_text 添加标签

geom_text(aes(label = corr), size = 3, colour = "black", alpha = 0.7)

为正负相关设置不同的颜色

geom_point(aes(fill = corr > 0, size = corr), shape = 21)

5. 混合绘图

如果想绘制上三角或下三角该怎么做？

ggplot2 并没有提供相应的操作，但是我们可以手动对数据进行处理，将对应的数据赋值为 NA

比如，我想绘制下三角。首先，把上三角赋值为 NA

mat <- as.data.frame(round(cor(mtcars), 2))

for (i in 1:10) {
  for (j in (i+1):11) {
    mat[i,j] <- NA
  }
}

然后将变量名的顺序固定为行名顺序

mat$var1 <- rownames(mat)
data <- gather(mat, key = "var2", value = "corr", -var1) %>%
  mutate(var1 = factor(var1, levels = rownames(mat)),
         var2 = factor(var2, levels = rownames(mat)))

然后绘制图形

my_color <- brewer.pal(5, "Spectral")

ggplot(data, aes(var1, var2)) +
  geom_point(aes(fill = corr, size = corr), shape = 21) +
  geom_text(aes(label = corr), size = 3, colour = "white") +
  scale_fill_gradientn(colours = my_color) +
  scale_size_area(max_size = 15, guide = FALSE) +
  theme(legend.position = "none")

如果想将文本和形状分别绘制在上三角和下三角，操作也是类似的，只是要多添加一个上三角矩阵。

mat1 <- as.data.frame(round(cor(mtcars), 2))

for (i in 1:10) {
  for (j in (i+1):11) {
    mat1[i,j] <- NA
  }
}

mat2 <- as.data.frame(round(cor(mtcars), 2))

for (i in 1:11) {
  for (j in 1:i) {
    mat2[i,j] <- NA
  }
}


mat1$var1 <- rownames(mat1)
data1 <- gather(mat1, key = "var2", value = "corr", -var1) %>%
  mutate(var1 = factor(var1, levels = rownames(mat1)),
         var2 = factor(var2, levels = rownames(mat1)))

mat2$var1 <- rownames(mat2)
data2 <- gather(mat2, key = "var2", value = "corr", -var1) %>%
  mutate(var1 = factor(var1, levels = rownames(mat2)),
         var2 = factor(var2, levels = rownames(mat2)))

my_color <- brewer.pal(5, "Spectral")

ggplot(data1, aes(var1, var2)) +
  geom_point(aes(fill = corr, size = corr), shape = 21) +
  geom_text(data = data2, aes(label = corr, colour = corr), size = 5) +
  scale_fill_gradientn(colours = my_color) +
  scale_colour_gradientn(colours = my_color) +
  scale_size_area(max_size = 15, guide = FALSE) +
  theme(legend.position = "none")

如果要将对角线换成变量名，也很简单

mat1 <- as.data.frame(round(cor(mtcars), 2))

for (i in 1:11) {
  for (j in i:11) {
    mat1[i,j] <- NA
  }
}

mat2 <- as.data.frame(round(cor(mtcars), 2))

for (i in 1:11) {
  for (j in 1:i) {
    mat2[i,j] <- NA
  }
}

var_name <- data1 %>% 
  filter(var1 == var2)

mat1$var1 <- rownames(mat1)
data1 <- gather(mat1, key = "var2", value = "corr", -var1) %>%
  mutate(var1 = factor(var1, levels = rownames(mat1)),
         var2 = factor(var2, levels = rownames(mat1)))

mat2$var1 <- rownames(mat2)
data2 <- gather(mat2, key = "var2", value = "corr", -var1) %>%
  mutate(var1 = factor(var1, levels = rownames(mat2)),
         var2 = factor(var2, levels = rownames(mat2)))

my_color <- brewer.pal(5, "Spectral")

ggplot(data1, aes(var1, var2)) +
  geom_point(aes(fill = corr, size = corr), shape = 21) +
  #geom_point(data = data2, aes(fill = corr, size = corr), shape = 23) +
  geom_text(data = data2, aes(label = corr, colour = corr), size = 5) +
  geom_text(data = var_name, aes(label = var1), size = 5) +
  scale_fill_gradientn(colours = my_color) +
  scale_colour_gradientn(colours = my_color) +
  scale_size_area(max_size = 15, guide = FALSE) +
  scale_x_discrete(position = 't') +
  theme(
    legend.position = "none",
    axis.title = element_blank()
    )

方块配圆形

geom_point(data = data2, aes(fill = corr, size = corr), shape = 22) +
# geom_text(data = data2, aes(label = corr, colour = corr), size = 5) +

热图配圆形

ggplot(data1, aes(var1, var2)) +
  geom_tile(data = data2, aes(fill = corr), na.rm = TRUE) +
  geom_text(data = data2, aes(label = corr), colour = "black", size = 5) +
  geom_point(aes(fill = corr, size = corr), shape = 21) +
  geom_text(data = var_name, aes(label = var1), size = 5) +
  scale_fill_gradientn(colours = my_color, na.value = "white") +
  scale_colour_gradientn(colours = my_color) +
  scale_size_area(max_size = 15, guide = FALSE) +
  scale_x_discrete(position = 't') +
  theme(
    panel.background = element_blank(),
    legend.position = "none",
    axis.title = element_blank()
    )

注意，需要将 geom_tile 放在最前面，同时设置 na.value 参数的值

代码：https://github.com/dxsbiocc/learn/blob/main/R/plot/corr_plot.R

总结一下，其实用 ggplot2 做个性化绘图没那么难，重要的是理解其中的原理。