Combine two correlation statistics into one heatmap using ggplot geom

dt <- data.frame(
  h = rep(LETTERS[1:5], 5), 
  j = c(rep("A", 5), rep("B", 5), rep("C", 5), rep("D", 5), rep("E", 5)),
  d1 = c(1, 0.717, 0.089, 0.027, 1, 0.717, 1, 0.11, 0.03, 1, 0.089, 0.11,
         1, 0.464, 0.835, 0.027, 0.03, 0.464, 1, 1, 1, 1, 0.835, 1, 1), 
  r1 = c(1, 0.462, 0.002, 0.001, 0.001, 0.462, 1, 0.003, 0.001, 0.001, 0.002,
         0.003, 1, 0.054, 0.004, 0.001, 0.001, 0.054, 1, 0.001, 0.001, 0.001, 0.004, 0.001, 1)
)


# Heatmap using d1 as the input value
ggplot(dt, aes(x = h, y = j, fill = d1))   
  geom_tile(color = "black")  
  scale_fill_gradient(low = "white", high = "green")  
  geom_text(aes(label = d1), color = "black", size = 4)  
  coord_fixed()  
  theme_minimal()  
  labs(x = "",
       y = "",
       fill = "D")

# Heatmap using r1 as the input value
ggplot(dt, aes(x = h, y = j, fill = r1))   
  geom_tile(color = "black")  
  scale_fill_gradient(low = "white", high = "red")  
  geom_text(aes(label = r1), color = "black", size = 4)  
  coord_fixed()  
  theme_minimal()  
  labs(x = "",
       y = "",
       fill = "r")

For each of the heatmaps that I just made, half of the blocks are repeating the same information as the other half. Given that the axes are the same, I would like to combine the 2 heatmaps above into one that looks like the following - half is showing d1 values (using 1 color) and the other half is showing r1 values (using a different color). The diagonal blocks will be in color 3.

CodePudding user response：

One option would be to use multiple geom_tiles with appropriately filtered data and the ggnewscale package which allows to have multiple scales for the same aesthetic to color the lower and upper diagonal matrices differently:

library(ggplot2)
library(ggnewscale)

# Add numeric row and column indices
dt <- transform(dt, row = as.numeric(factor(j)), 
                col = as.numeric(factor(h)))

size_border <- 2

ggplot(dt, aes(x = h, y = j))   
  # Diagonal
  geom_tile(data = ~ subset(.x, row == col), color = "white", fill = "purple", size = size_border)  
  geom_text(aes(label = d1), data = ~ subset(.x, row == col), color = "black", size = 4)  
  # Upper
  geom_tile(aes(fill = d1), data = ~ subset(.x, row > col), color = "white", size = size_border)  
  geom_text(aes(label = d1), data = ~ subset(.x, row > col), color = "black", size = 4)  
  scale_fill_gradient(low = "white", high = "blue", limits = c(0, 1))  
  # Lower
  new_scale_fill()  
  geom_tile(aes(fill = r1), data = ~ subset(.x, row < col), color = "white", size = size_border)  
  geom_text(aes(label = r1), data = ~ subset(.x, row < col), color = "black", size = 4)  
  scale_fill_gradient(low = "white", high = "red", limits = c(0, 1))  
  coord_fixed()  
  theme_minimal()  
  labs(x = NULL,
       y = NULL)