ggpairs plot with heatmap of correlation values with significance stars and custom theme

问题

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

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.

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.

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

MWE

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")

回答1:

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
        )

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)
}

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

来源：https://stackoverflow.com/questions/62196950/ggpairs-plot-with-heatmap-of-correlation-values-with-significance-stars-and-cust

标签

ggplot2

ggally

ggpairs