R：如何使用 ggplot2 創建具有一半顏色和一半數字的熱圖？

Question

我正在嘗試創建一個由熱圖表示的相關矩陣，其中一半使用顏色的熱圖，另一半使用實際相關值。

到目前為止，我已經能夠創建兩個單獨的三角形熱圖（一個帶有顏色，另一個帶有相關值）。 有沒有辦法在 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)

Answer 1

我將數據和映射從 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()

Answer 2

對於您的問題一 - 最方便的方法是免費使用已經為我們創建的包:)

我特別知道有兩個包，{GGally} 和 {ggcorrplot}。 兩者都允許使用疊加標簽輕松創建相關熱圖。

問題 2 可能有點老套，我猜蘇珊的回答似乎合理。

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 包(v2.0.1) 於 2021 年 11 月 16 日創建}