带有相关值热图的 ggpairs 绘图

Question

我的问题是双重的；

我有一个默认为 upper = list(continuous = cor) 的 ggpairs 图，我想通过相关值对图块着色（就像 ggcorr 所做的那样）。

我有这个：
我希望上图的相关值像这样着色：

library(GGally)

sample_df <- data.frame(replicate(7,sample(0:5000,100)))
colnames(sample_df) <- c("KUM", "MHP", "WEB", "OSH", "JAC", "WSW", "gaugings")

ggpairs(sample_df, lower = list(continuous = "smooth"))  
ggcorr(sample_df, label = TRUE, label_round = 2)

我曾短暂尝试使用 upper = list(continuous = wrap(ggcorr)，但运气不佳，而且鉴于这两个函数都返回绘图调用，我认为这不是正确的路径吗？

我知道我可以在 ggplot 中构建它（例如 Sandy Muspratt's solution），但鉴于 GGally 包已经具有我正在寻找的功能，我想我可能会忽略一些东西。

---

更广泛地说，我想知道我们如何（或者如果可以的话）调用相关值？一个更简单的选择可能是为标签而不是瓷砖着色（即this question 使用颜色而不是大小），但我需要一个变量来分配颜色......

能够调用相关值以在其他图中使用会很方便，尽管我想我可以自己重新计算它们。

谢谢！

Answer 1

一种可能的解决方案是从ggcorr 相关矩阵图中获取颜色列表，并将这些颜色设置为ggpairs 矩阵图上方图块中的背景。

library(GGally)   
library(mvtnorm)
# Generate data
set.seed(1)
n <- 100
p <- 7
A <- matrix(runif(p^2)*2-1, ncol=p) 
Sigma <- cov2cor(t(A) %*% A)
sample_df <- data.frame(rmvnorm(n, mean=rep(0,p), sigma=Sigma))
colnames(sample_df) <- c("KUM", "MHP", "WEB", "OSH", "JAC", "WSW", "gaugings")

# Matrix of plots
p1 <- ggpairs(sample_df, lower = list(continuous = "smooth"))  
# Correlation matrix plot
p2 <- ggcorr(sample_df, label = TRUE, label_round = 2)

相关矩阵图为：

# Get list of colors from the correlation matrix plot
library(ggplot2)
g2 <- ggplotGrob(p2)
colors <- g2$grobs[[6]]$children[[3]]$gp$fill

# Change background color to tiles in the upper triangular matrix of plots 
idx <- 1
for (k1 in 1:(p-1)) {
  for (k2 in (k1+1):p) {
    plt <- getPlot(p1,k1,k2) +
     theme(panel.background = element_rect(fill = colors[idx], color="white"),
           panel.grid.major = element_line(color=colors[idx]))
    p1 <- putPlot(p1,plt,k1,k2)
    idx <- idx+1
}
}
print(p1)

Answer 2

您可以通过编写一个可以直接传递给ggpairs 的快速自定义函数将背景颜色映射到单元格。这涉及计算变量对之间的相关性，然后匹配到一些用户指定的颜色范围。

my_fn <- function(data, mapping, method="p", use="pairwise", ...){

              # grab data
              x <- eval_data_col(data, mapping$x)
              y <- eval_data_col(data, mapping$y)

              # calculate correlation
              corr <- cor(x, y, method=method, use=use)

              # calculate colour based on correlation value
              # Here I have set a correlation of minus one to blue, 
              # zero to white, and one to red 
              # Change this to suit: possibly extend to add as an argument of `my_fn`
              colFn <- colorRampPalette(c("blue", "white", "red"), interpolate ='spline')
              fill <- colFn(100)[findInterval(corr, seq(-1, 1, length=100))]

              ggally_cor(data = data, mapping = mapping, ...) + 
                theme_void() +
                theme(panel.background = element_rect(fill=fill))
            }

使用 Marco 回答中的数据：

library(GGally)    # version: ‘1.4.0’

p1 <- ggpairs(sample_df, 
                   upper = list(continuous = my_fn),
                   lower = list(continuous = "smooth"))  

这给出了：

---

后续问题Change axis labels of a modified ggpairs plot (heatmap of correlation) 指出，theme 的后期绘图更新导致panel.background 颜色被删除。这可以通过删除theme_void 并删除主题中的网格线来解决。即将相关位更改为（注意 ggplot2 v3.3.0 不需要此修复）

ggally_cor(data = data, mapping = mapping, ...) + 
           theme(panel.background = element_rect(fill=fill, colour=NA),
                 panel.grid.major = element_blank())