R：如何使用 ggplot2 创建一个半色半数的热图？

Posted 2023-02-16

【中文标题】R：如何使用 ggplot2 创建一个半色半数的热图？

【英文标题】：R: how to create a heatmap with half colours and half numbers using ggplot2?

【发布时间】：2021-12-27 16:56:55

【问题描述】：

我正在尝试创建一个由热图表示的相关矩阵，其中一半的热图使用颜色，另一半使用实际的相关值。

到目前为止，我已经能够创建两个单独的三角形热图（一个带有颜色，另一个带有相关值）。有没有办法在 ggplot2 中叠加或组合这些图以创建一个热图？是否有另一种更有效的方法来创建一半颜色和一半数字的热图？

下面是我的代码，向您展示我到目前为止所做的事情。

A <- c(1,4,5,6,1)
B <- c(4,2,5,6,7)
C <- c(3,4,2,4,6)
D <- c(2,5,1,4,6)
E <- c(6,7,8,9,1)

df <- data.frame(A,B,C,D,E)

CorMat <- cor(df[ ,c("A","B","C","D","E")])

get_upper_tri <- function(CorMat)
    CorMat[upper.tri(CorMat)]<- NA
    return(CorMat)


get_lower_tri <- function(CorMat)
    CorMat[lower.tri(CorMat)]<- NA
    return(CorMat)


reorder <- function(CorMat)
dd <- as.dist((1-CorMat)/2)
hc <- hclust(dd)
CorMar <- CorMat[hc$order, hc$order]


CorMat <- reorder(CorMat)
upper_tri <- get_upper_tri(CorMat)
lower_tri <- get_lower_tri(CorMat)
meltNum <- melt(lower_tri, na.rm = T)
meltColor <- melt(upper_tri, na.rm = T)

ggheatmapColor <- ggplot(meltColor, aes(Var2, Var1, fill = value)) +
    labs(x = NULL, y = NULL) +
    geom_tile(color = "white") +
    scale_x_discrete(position = "top") +
    scale_fill_gradient(low = "white", high = "firebrick4",
        limit = c(-1,1), name = "Pearson\nCorrelation") +
    theme(plot.title = element_text(hjust = 0.5, face = "bold"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank()) +
    coord_fixed()

print(ggheatmapColor)

ggheatmapNum <- ggplot(meltNum, aes(Var2, Var1, label = round(value, digit = 2))) +
    geom_text(color = "black", size = 4) +
    labs(x = NULL, y = NULL) +
    scale_x_discrete(position = "top") +
    theme(plot.title = element_text(hjust = 0.5, face = "bold"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank()) +
    coord_fixed()

print(ggheatmapNum)

【参考方案1】：

对于您的问题之一 - 最方便的方法是免费使用已经为我们创建的包 :)

我特别知道有两个包，GGally 和 ggcorrplot。两者都允许超级轻松地创建带有重叠标签的相关热图。

问题 2 可能有点 hacky，我猜 Susan 的回答似乎是合理的。

A <- c(1,4,5,6,1)
B <- c(4,2,5,6,7)
C <- c(3,4,2,4,6)
D <- c(2,5,1,4,6)
E <- c(6,7,8,9,1)

df <- data.frame(A,B,C,D,E)

ggcorrplot::ggcorrplot(cor(df), type = "lower", lab = TRUE)

GGally::ggcorr(df, label = TRUE)
#> Registered S3 method overwritten by 'GGally':
#>   method from   
#>   +.gg   ggplot2

^{由reprex package (v2.0.1) 于 2021 年 11 月 16 日创建}

【讨论】：

是的，我知道某些软件包可以实现我想要的，但我希望能够使用 ggplot2 来实现我需要的小型定制。感谢您的帮助。

【参考方案2】：

我将数据和映射从 ggplot() 移动到 geom_heatmap() 并添加了 geom_text() 也许这更接近您想要的结果？

A <- c(1,4,5,6,1)
B <- c(4,2,5,6,7)
C <- c(3,4,2,4,6)
D <- c(2,5,1,4,6)
E <- c(6,7,8,9,1)

df <- data.frame(A,B,C,D,E)

CorMat <- cor(df[ ,c("A","B","C","D","E")])

get_upper_tri <- function(CorMat)
  CorMat[upper.tri(CorMat)]<- NA
  return(CorMat)


get_lower_tri <- function(CorMat)
  CorMat[lower.tri(CorMat)]<- NA
  return(CorMat)


reorder <- function(CorMat)
  dd <- as.dist((1-CorMat)/2)
  hc <- hclust(dd)
  CorMar <- CorMat[hc$order, hc$order]

library(reshape2)

CorMat <- reorder(CorMat)
upper_tri <- get_upper_tri(CorMat)
lower_tri <- get_lower_tri(CorMat)
meltNum <- melt(lower_tri, na.rm = T)
meltColor <- melt(upper_tri, na.rm = T)
library(tidyverse)
 ggplot() +
  labs(x = NULL, y = NULL) +
  geom_tile(data = meltColor, 
            mapping = aes(Var2, Var1, 
                          fill = value)) +
  geom_text(data = meltNum,
            mapping = aes(Var2, Var1,
                          label = round(value, digit = 2))) +
  scale_x_discrete(position = "top") +
  scale_fill_gradient(low = "white", high = "firebrick4",
                      limit = c(-1,1), name = "Pearson\nCorrelation") +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank()) +
  coord_fixed()

【讨论】：

感谢您的帮助，这正是我希望实现的。