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

如何解决是否可以拆分相关框以显示配对图中两种不同处理的相关值？

使用下面的代码，我创建了一个散点图矩阵。下面的代码只是为所有数据创建了一个相关矩阵，而不管处理如何。但是，我的数据中的一列是“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,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,# To make lm bold,use size = 1.3
                      emap=aes(color=Si),fullrange=TRUE,se=FALSE))) +
  theme(legend.position='top')

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

解决方法

下面的快速功能可帮助您入门。与用于单个值的更简单的 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],use=use))) lvs <- if(is.character(col)) sort(unique(col)) else levels(col) fill <- colFn(100)[findInterval(corr,length=100))] cuts <- seq(min(y,na.rm=TRUE),max(y,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,fill=fill) p <- ggplot(data=data,...) + 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))

event

产生什么