R中的ggplot在多个变量上添加显着性星号与对照组

Question

我有条形图，但想在每个“grp1”中运行 Wilcox.test，将条形与该组的对照进行比较，然后在显着时加上星号。

我已经看到“compare_means”来进行比较，但我正在尝试使其自动化而不是手动操作。 “geom_signif”或“stat_compare_means”会这样做吗？有人可以帮忙吗？非常感谢。

我需要使用完整的数据集进行比较，而不仅仅是平均值（每个柱只有一个值）。我在运行其中一个比较的代码末尾添加了一行，这样您就可以看到我需要从哪里获得 p 值。

y <- c(runif(100,0,4.5),runif(100,3,6),runif(100,4,7))
grp1 <- sample(c("A","B","C","D"),size = 300, replace = TRUE)
grp2 <- rep(c("High","Med","Contrl"),each=100)
dataset <- data.frame(y,grp1,grp2)

means <- aggregate(y~grp1+grp2,data=dataset,mean)
sd <- aggregate(y~grp1+grp2,data=dataset,function(x){sd(x)})

means.all <- merge(sd,means,by=c("grp1","grp2"))
names(means.all)[3:4] <- c("sd","y.mean")

library(ggplot2)
p<- ggplot(means.all, aes(x=grp1, y=y.mean, fill=grp2))+ 
  geom_bar(stat="identity", color="black", 
           position=position_dodge()) +
  geom_errorbar(aes(ymin=y.mean-sd, ymax=y.mean+sd), width=.2,
                position=position_dodge(.9))
p

compare_means(y~grp2,data = dataset[dataset$grp1=="A",],method="wilcox.test")

Answer 1

也许这不是最佳方式，但您可以创建一个拆分数据的列表，并在数据的每个级别单独应用 stat_compare_means() 函数。之后，您可以使用patchwork 将图合二为一：

library(ggplot2)
library(ggpubr)
library(patchwork)
#Split data
List <- split(means.all,means.all$grp1)
#Function for plot
myfun <- function(x)
{
  #Ref group
  rg <- paste0(unique(x$grp1),'.','Contrl')
  #Plot
  G <- ggplot(x, aes(x=interaction(grp1,grp2), y=y.mean, fill=grp2))+ 
    geom_bar(stat="identity", color="black", 
             position=position_dodge()) +
    geom_errorbar(aes(ymin=y.mean-sd, ymax=y.mean+sd), width=.2,
                  position=position_dodge(.9))+
    stat_compare_means(ref.group = rg,label =  "p.signif",method = "wilcox.test",label.y = 7)+
    theme(axis.text.x = element_blank())+
    xlab(unique(x$grp1))
  return(G)
}
#Apply
Lplot <- lapply(List, myfun)
#Wrap plots
wrap_plots(Lplot,nrow = 1)+plot_layout(guides = 'collect')

输出：

考虑这个更新，它将星号的值存储在一个新的数据框中：

#Create p-vals dataset
List2 <- split(dataset,dataset$grp1)
#p-val function
mypval <- function(x)
{
  y <- compare_means(y~grp2,data = x,method="wilcox.test")
  y <- y[,c('group2', 'group1','p.signif')]
  names(y)<-c('grp2','grp1','p.signif')
  y <- y[y$grp2=='Contrl',]
  y$grp2 <- y$grp1
  y <- rbind(y,data.frame(grp2='Contrl',grp1='',p.signif=''))
  y$grp1 <- unique(x$grp1)
  y$y.mean=7
  return(y)
}
#Apply
dfpvals <- lapply(List2, mypval)
df <- do.call(rbind,dfpvals)
#Plot
ggplot(means.all, aes(x=grp1, y=y.mean, fill=grp2,group=grp2))+ 
  geom_bar(stat="identity", color="black", 
           position=position_dodge()) +
  geom_errorbar(aes(ymin=y.mean-sd, ymax=y.mean+sd), width=.2,
                position=position_dodge(.9))+
  geom_text(data=df,aes(x=grp1, y=y.mean,group=grp2,label=p.signif),
            position=position_dodge(0.9))

输出：