如何将斯皮尔曼相关性 p 值以及相关系数添加到 ggpairs 中？

Question

使用以下代码在 R 中构建 ggpairs 图形。

df 是一个包含 6 个连续变量和 1 个组变量的数据框

ggpairs(df[,-1],columns = 1:ncol(df[,-1]),
mapping=ggplot2::aes(colour = df$Group),legends = T,axisLabels = "show", 
upper = list(continuous = wrap("cor", method = "spearman", size = 2.5, hjust=0.7)))+ 
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))

我正在尝试将斯皮尔曼相关性的 p 值添加到生成的图形的上面板（即附加到斯皮尔曼相关系数）。

一般来说，p 值是使用cor.test 作为“Spearman”传递的方法计算的

还知道 StackOverFlow 帖子讨论与此类似的查询，但我需要ggpairs，该解决方案不起作用。另外，之前的查询还没有解决。

如何添加使用 R 中的对绘制的 Spearman 相关系数的 p 值

Answer 1

我有一种感觉，这超出了您的预期......所以您需要定义一个像ggally_cor这样的自定义函数，所以首先我们有一个打印两个变量之间相关性的函数：

printVar = function(x,y){
      vals = cor.test(x,y,
      method="spearman")[c("estimate","p.value")]
      names(vals) = c("rho","p")
      paste(names(vals),signif(unlist(vals),2),collapse="\n")
}

然后我们定义一个函数，接收每对数据，并计算 1. 总体相关性，2. 按组的相关性，并将其传递到 ggplot 中，基本上只打印以下文本：

my_fn <- function(data, mapping, ...){
  # takes in x and y for each panel
  xData <- eval_data_col(data, mapping$x)
  yData <- eval_data_col(data, mapping$y)
  colorData <- eval_data_col(data, mapping$colour)

# if you have colors, split according to color group and calculate cor

  byGroup =by(data.frame(xData,yData),colorData,function(i)printVar(i[,1],i[,2]))
  byGroup = data.frame(col=names(byGroup),label=as.character(byGroup))
  byGroup$x = 0.5
  byGroup$y = seq(0.8-0.3,0.2,length.out=nrow(byGroup))

#main correlation
mainCor = printVar(xData,yData)

p <- ggplot(data = data, mapping = mapping) +
annotate(x=0.5,y=0.8,label=mainCor,geom="text",size=3) +
geom_text(data=byGroup,inherit.aes=FALSE,
aes(x=x,y=y,col=col,label=label),size=3)+ 
theme_void() + ylim(c(0,1))
  p
}

现在我使用 mtcars，第一列是一个随机组：

df  =data.frame(
Group=sample(LETTERS[1:2],nrow(mtcars),replace=TRUE),
mtcars[,1:6]
)

和情节：

ggpairs(df[,-1],columns = 1:ncol(df[,-1]),
mapping=ggplot2::aes(colour = df$Group),
axisLabels = "show", 
upper = list(continuous = my_fn))+
theme(panel.grid.major = element_blank(), 
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black")) 

我认为对于你自己的情节，文本的间距可能不是最佳的，但这只是一个调整的问题my_fn。