Question

我写了一个函数来简化我正在做的一堆相关的可视化。具体来说，我有兴趣在ggplot2面板中并排查看双变量关系，其中p值和rho值直接打印在图表上。我使用iris数据集编写了这个函数：

library(ggplot2)
library(dplyr)

grouped_cor_ <- function(data, x, y, group.col){
  x <- lazyeval::as.lazy(x)
  y <- lazyeval::as.lazy(y)
  cor1 <- lazyeval::interp(~ cor.test(x, y,method="spearman",na.action = "na.exclude")$estimate, x = x, y = y)
  corp <- lazyeval::interp(~ cor.test(x, y,method="spearman", na.action = "na.exclude")$p.value, x = x, y = y)
  mnx <- lazyeval::interp(~ mean(x, na.rm=TRUE), x = x, y = y)
  mny <- lazyeval::interp(~ mean(y, na.rm=TRUE), x = x, y = y)

  summarise_(group_by(data, Species), rho=cor1, pval=corp, xcoord=mnx, ycoord=mny)
}

这是我用来打印相关性统计数据的数据框：

grouped_cor_(data=iris, x=~Petal.Width, y=~Petal.Length)

然后这是调用绘图的函数：

corHighlight <- function(Data, x, y){
  cordf<-grouped_cor_(Data, x = substitute(x), y = substitute(y))
  cordf$prho <- paste("rho=",round(cordf$rho,3), "\n p-value=",round(cordf$pval,3), sep=" ")
  plt<-ggplot(Data, aes_q(x = substitute(x), y = substitute(y))) + 
    geom_text(data=cordf, aes_q(x=substitute(xcoord), 
                            y=substitute(ycoord), 
                            label=substitute(prho)), colour='red') + 
    geom_point(size=2, alpha=0.3) +
    facet_wrap(~Species)
  print(plt)
}


corHighlight(Data=iris, 
         x=Petal.Width, 
         y=Petal.Length)

这个功能虽然有点笨拙但现在运行得很好，有一个我似乎无法弄清楚的小细节。我无法弄清楚如何为分组变量添加列规范。现在，该函数与iris数据集绑定，因为它只接受名为`species'的分组变量。那么我的问题是如何将此函数与虹膜数据集分开并推广分组变量。

有人能推荐一种有效的方法吗？很高兴接受任何改进功能的评论。

Answer 1

这样您就可以将单个分组因子传递给辅助函数。是否需要使用group_by_，因为我将公式中的名称作为字符提取，然后将其强制转换为名称：

grouped_cor_ <- function(data, x, y, form){
  x <- lazyeval::as.lazy(x)
  y <- lazyeval::as.lazy(y); fac <- as.name(as.character(form)[2])
  cor1 <- lazyeval::interp(~ cor.test(x, y,method="spearman",na.action = "na.exclude")$estimate, x = x, y = y)
  corp <- lazyeval::interp(~ cor.test(x, y,method="spearman", na.action = "na.exclude")$p.value, x = x, y = y)
  mnx <- lazyeval::interp(~ mean(x, na.rm=TRUE), x = x, y = y)
  mny <- lazyeval::interp(~ mean(y, na.rm=TRUE), x = x, y = y)

  summarise_( group_by_(data, fac), rho=cor1, pval=corp, xcoord=mnx, ycoord=mny)
}

说明我在评论中说的内容（允许函数接受可以由`facet_wrap``处理的公式：

corHighlight <- function(Data, x, y, form){
  cordf<-grouped_cor_(Data, x = substitute(x), y = substitute(y), form=substitute(form))
  cordf$prho <- paste("rho=",round(cordf$rho,3), "\n p-value=",round(cordf$pval,3), sep=" ")
  plt<-ggplot(Data, aes_q(x = substitute(x), y = substitute(y))) + 
    geom_text(data=cordf, aes_q(x=substitute(xcoord), 
                            y=substitute(ycoord), 
                            label=substitute(prho)), colour='red') + 
    geom_point(size=2, alpha=0.3) +
    facet_wrap(form)
  print(plt)
}
corHighlight(Data=iris, 
         x=Petal.Width, 
         y=Petal.Length, form = ~Species)

在函数

1 个答案: