ggpairs用相关性值的热图绘制，并带有重要星号和自定义主题 [英] ggpairs plot with heatmap of correlation values with significance stars and custom theme

问题描述

我想用ggPairs()创建一个相关图，其中应包含

I would like to create a correlation plot with ggPairs() which should contain

• 相关值的热图(如本SO问题中所述)
• 相关性的显着性星标( )
• 根据自定义主题的字体类型和字体大小.

• a heat map of correlation values (as in this SO question)
• significance stars for the correlation (as in this SO question)
• font type and font size according to a custom theme.

基于@ user20650为上述SO问题提供的出色解决方案，我成功构建了一个函数来生成具有重要恒星的相关值的热图.

Based on the excellent solutions provided by @user20650 to the above mentioned SO questions, I succeeded in building a function to generate a heatmap of correlation values with significance stars.

不幸的是，添加(自定义)主题时，彩色面板会被删除.背景(下面提供了MWE).

Unfortunately, when adding the (custom) theme, the colored panel.backgrounds are removed (MWE is provided below).

library(ggplot2)
library(GGally)
# fct. to create heatmap of correlation values with significance stars for upper triangle of ggpairs plot
cor_fun <- function(data, mapping, method="pearson", use="pairwise", ndp=2, sz=5, stars=TRUE, ...){

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

# calculate correlation: for significance stars
corr <- cor.test(x, y, method=method)
est <- corr$estimate
lb.size <- sz* abs(est)

# get significance stars
if(stars){
  stars <- c("***", "**", "*", "")[findInterval(corr$p.value, c(0, 0.001, 0.01, 0.05, 1))]
  lbl <- paste0(round(est, ndp), stars)
}else{
  lbl <- round(est, ndp)
}

# calculate correlation: for colored tiles
corr <- cor(x, y, method=method, use=use)

# calculate color based on correlation value
# corr = -1 => blue, 
# corr =  0 => white, 
# corr = +1 => red, 
colFn <- colorRampPalette(c("blue", "white", "red"), interpolate ='spline')
fill <- colFn(100)[findInterval(corr, seq(-1, 1, length=100))]

ggplot(data = data, mapping = mapping, ...) + 
  theme_void() +
  annotate("text",
           x=mean(x, na.rm=TRUE),
           y=mean(y, na.rm=TRUE),
           label=lbl,
           size=lb.size,
           ...) +
  theme(panel.background = element_rect(fill=fill,  # to fill background of panel with color
                                        colour=NA), # to remove border of panel
        panel.grid.major = element_blank())
}

sample_df <- iris[,1:3]
ggpairs(sample_df, 
        # LOWER TRIANGLE ELEMENTS: add line with smoothing; make points transparent and smaller
        lower=list(continuous=wrap("smooth", colour="darkgreen", alpha = 0.3, size=0.8)),
        # DIAGONAL ELEMENTS: histograms instead of smooothed density
        diag=list(continuous=wrap("barDiag", fill="grey")),
        # UPPER TRIANGLE ELEMENTS: use new fct. to create heatmap of correlation values with significance stars
        upper=list(continuous=cor_fun)
)  + theme_minimal(base_size=12, base_family="Lato Light")

推荐答案

以@ user20650的评论为基础，我找到了一个我想与遇到类似困难的人分享的解决方案:

Building on the comment from @user20650 I was able to find a solution which I would like to share with others experiencing similar difficulties:

library(ggplot2)
library(GGally)
theme_lato <- theme_minimal(base_size=10, base_family="Lato Light")

ggpairs(sample_df, 
        # LOWER TRIANGLE ELEMENTS: add line with smoothing; make points transparent and smaller
        lower = list(continuous = function(...) 
          ggally_smooth(..., colour="darkgreen", alpha = 0.3, size=0.8) + theme_lato), 
        # DIAGONAL ELEMENTS: histograms
        diag = list(continuous = function(...) 
          ggally_barDiag(..., fill="grey") + theme_lato),
          # to plot smooth densities instead: use ggally_densityDiag() or better my_dens(), see comment below
        # UPPER TRIANGLE ELEMENTS: use new fct. to create heatmap of correlation values with significance stars
        upper = list(continuous = cor_fun)
        ) + 
  theme(# adjust strip texts
        strip.background = element_blank(), # remove color
        strip.text = element_text(size=12, family="Lato Light"), # change font and font size
        axis.line = element_line(colour = "grey"),
        # remove grid
        panel.grid.minor = element_blank(),   # remove smaller gridlines
        # panel.grid.major = element_blank()    # remove larger gridlines
        ) 

如果有兴趣在对角线上绘制密度而不是直方图:ggally_densityDiag()可能导致密度大于1. 以下功能.可以代替:

If of interest to plot densities instead of histograms on the diagonal: ggally_densityDiag() can lead to densities being greater than 1. The following fct. can be used instead:

my_dens <- function(data, mapping, ...) {
  ggplot(data = data, mapping=mapping) +
    geom_density(..., aes(x=..., y=..scaled..), alpha = 0.7, color = NA)
}

会话信息: MacOs 10.13.6，R 3.6.3，ggplot2_3.3.1，GGally_1.5.0

Session info: MacOs 10.13.6, R 3.6.3, ggplot2_3.3.1, GGally_1.5.0

这篇关于ggpairs用相关性值的热图绘制，并带有重要星号和自定义主题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！