是否可以拆分相关框以显示 pairplot 中两种不同处理的相关值？

Question

使用下面的代码，我创建了一个散点图矩阵。下面的代码只是为所有数据创建一个相关矩阵，无论处理方式如何。但是，我的数据中有一列是“Si”。我想通过将盒子分成两个来制作两个不同的矩阵（每个治疗类型一个）以便更好地比较，就像我对较低功能（Si 水平，0mM，4mM）所做的那样。

library(GGally) 
leg <- grab_legend(ggplot(data=data1, aes(x=NA, y=NA, colour=Si)) +
                     geom_line(size=2))

my_fn <- function(data1, mapping, method="p", use="pairwise", ...){
  
  # grab data
  x <- eval_data_col(data1, mapping$x)
  y <- eval_data_col(data1, 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=data1, size=5, digits=2, stars=TRUE, mapping=mapping, ...) + 
    theme_void() +
    theme(panel.background=element_rect(fill=fill))
}

lowerFn <- function(data1, mapping, emap=NULL, method = "lm", ...) {
  # mapping <- c(mapping, emap)
  # class(mapping) = "uneval" # need this to combine the two aes
  # Can use this instead
  mapping <- ggplot2:::new_aes( c(mapping, emap))
  p <- ggplot(data = data1, mapping = mapping) +
    geom_point(data = data1, alpha = 0.8, size = 3, shape = 16) +
    geom_smooth(method = method, ...) +
    theme_gray() # to get the white background and prominent axis
  p
}

ggpairs(
  data1, columns=4:6, legend=leg,
  upper = list(continuous=my_fn),
  lower = list(continuous = 
                 wrap(lowerFn, 
                      method = "lm", # To make lm bold, use size = 1.3
                      emap=aes(color=Si),
                      fullrange=TRUE, 
                      se=FALSE))) +
  theme(legend.position='top')

这里是数据link； https://docs.google.com/spreadsheets/d/1O5haLrVNsLx4_Sn-mr7lUaON4MnwLegpeg2OieODt8I/edit?usp=sharing

Answer 1

下面是一个快速入门的功能。这只是看看如何划分上三角面板，其中使用 geom_rect，与用于单个值的更容易的 panel.background 相比。代码中的注释指出计算文本和矩形坐标的位置。

library(GGally)
library(ggplot2)

my_fn <- function(data, mapping, method="p", use="pairwise", ndp=2, ...){
  
    # grab data
    x <- eval_data_col(data, mapping$x)
    y <- eval_data_col(data, mapping$y)
    col <- eval_data_col(data, mapping$colour)

    # calculate correlation
    colFn <- colorRampPalette(c("blue", "white", "red"), interpolate ='spline')

    if(is.null(col)) {
        corr <- cor(x, y, method=method, use=use)
        fill <- colFn(100)[findInterval(corr, seq(-1, 1, length=100))]
        p <- ggally_cor(data=data, size=5, digits=2, stars=TRUE, mapping=mapping, ...) +
                theme_void() +
                theme(panel.background=element_rect(fill=fill))
        }
    
    # getting cor values by group which we will use to colour
    if(!is.null(col)) {
        idx <- split(seq_len(nrow(data)), col)
        corr <- unlist(lapply(idx, function(i) cor(x[i], y[i], method=method, use=use)))
        lvs <- if(is.character(col)) sort(unique(col)) else levels(col)
        fill <- colFn(100)[findInterval(corr, seq(-1, 1, length=100))]
        cuts <- seq(min(y, na.rm=TRUE), max(y, na.rm=TRUE), length=length(idx)+1L)
        pos <- (head(cuts, -1) + tail(cuts, -1))/2 # for labels
        cuts[1] <- -Inf; cuts[length(idx)+1L] <- Inf # for rects
        rects <- data.frame(from=head(cuts, -1), to=tail(cuts, -1), fill=fill)
    
        p <- ggplot(data=data, mapping=mapping, ...) + 
                geom_blank() + 
                theme_void() + 
                geom_rect(data=rects, aes(xmin=-Inf, xmax=Inf, ymin=from, ymax=to), fill=fill, inherit.aes = FALSE) +
                annotate("text", x=mean(x), y=pos, label=paste(lvs, ": ", round(corr, ndp)))
        
        }

        return(p)
}

ggpairs(iris, columns=1:4,   mapping=aes(colour=Species), upper = list(continuous=my_fn))

产生

是否可以拆分相关框以显示 pairplot 中两种不同处理的相关值？

Is it possible to split correlation box to show correlation values for two different treatments in pairplot?

r

ggplot2

ggally