4

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

基于@user20650对上述SO问题提供的优秀解决方案，我成功地构建了一个函数来生成带有重要性星的相关值的热图。

不幸的是，在添加（自定义）主题时，彩色 panel.backgrounds 被删除（下面提供了 MWE）。

在此处输入图像描述

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

1 回答 1

4

基于@user20650 的评论，我找到了一个我想与遇到类似困难的其他人分享的解决方案：

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。以下 fct。可以改用：

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

于 2020-06-04T14:18:24.013 回答