具有 Wilcoxon 显着性水平和方面的箱线图仅显示与星号的显着比较 [英] Boxplots with Wilcoxon significance levels, and facets, show only significant comparisons with asterisks
本文介绍了具有 Wilcoxon 显着性水平和方面的箱线图仅显示与星号的显着比较的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
跟进
如您所见，存在一些问题，最明显的是:
1- 着色由于某种原因不起作用
2-我似乎无法更改带有星号的注释
我想要更像这样的东西(模型):
所以我们需要:
1-使着色工作
2- 显示星号而不是数字
...为了胜利:
3-创造一个共同的传奇
4- 将 Kruskal-Wallis 线置于顶部
5- 更改标题和 y 轴文本的大小(和对齐方式)
重要说明
我希望我的代码尽可能完整，即使它不是最漂亮的，因为我仍然需要使用诸如CNb"或pv.final"之类的中间对象.
解决方案应该很容易转移到其他情况；请考虑单独测试变量"，而不是两者"......在这种情况下，我们有 6 个方面"(垂直和水平)，一切都变得更加混乱......
我制作了另一个 MWE:
##NOW 测试测量，获得垂直和水平面addkw <- as.data.frame(mydf %>% group_by(treatment, Species) %>%总结(p.value = kruskal.test(value ~ variable)$p.value))#addkw$p.adjust <- p.adjust(addkw$p.value, "BH")a <- combn(levels(mydf$variable), 2, 简化 = FALSE)#新的p.valuespv.final <- data.frame()for (tr in levels(mydf$treatment)){for (gr in levels(mydf$Species)){for (i in 1:length(a)){tis <- a[[i]] #要测试的变量对as <- subset(mydf,treatment==tr & Species==gr & variable %in% tis)pv <- wilcox.test(value ~ variable, data=as)$p.valueddd <- data.table(as)asm <- as.data.frame(ddd[, list(value=mean(value, na.rm=T)), by=list(variable=variable)])asm2 <- dcast(asm, .~variable, value.var="value")[,-1]pf <- data.frame(group1=paste(tis[1], gr, tr), group2=paste(tis[2], gr, tr), mean.group1=asm2[,1], mean.group2=asm2[,2], FC.1over2=asm2[,1]/asm2[,2], p.value=pv)pv.final <- rbind(pv.final, pf)}}}#pv.final$p.adjust <- p.adjust(pv.final$p.value, method="BH")# 设置信号级别pv.final$map.signif <- ifelse(pv.final$p.value > 0.05, "", ifelse(pv.final$p.value > 0.01,"*", "**"))plot.list2=function(mydf, pv.final, addkw, a, myPal){mylist <- list()我＜- 0for (sp in unique(mydf$Species)){for (tr in unique(mydf$treatment)){i <- i+1mydf0 <-子集(mydf，物种== sp &treatment==tr)addkw0 <- 子集(addkw，物种== sp &treatment==tr)pv.final0 <- pv.final[grep(paste(sp,tr), pv.final$group1), ]num.signif <- sum(pv.final0$p.value <= 0.05)P <- ggplot(mydf0,aes(x=variable, y=value)) +geom_boxplot(aes(fill=Species)) +stat_summary(fun.y=mean, geom="point", shape=5, size=4) +facet_grid(治疗~物种，比例=自由"，空间=free_x")+scale_fill_manual(values=myPal[i]) + #为什么忽略颜色?geom_text(data=addkw0, hjust=0, size=4.5, aes(x=0, y=round(max(mydf0$value, na.rm=TRUE)+0.5), label=paste0("KW p=",p.value))) +geom_signif(test="wilcox.test", compares = a[which(pv.final0$p.value<=0.05)],#这里可以用a"map_signif_level = F,vjust=0,文字大小=4，尺寸=0.5，step_increase = 0.05)如果(我== 1){P <- P + 主题(legend.position="none",axis.text.x=element_blank(),axis.text.y=element_text(size=20),axis.title=element_blank(),axis.ticks.x=element_blank(),strip.text.x=element_text(size=20,face="bold"),strip.text.y=element_text(size=20,face="bold"))}如果 (i==4){P <- P + 主题(legend.position="none",axis.text.x=element_text(大小=20，角度=90，hjust=1)，axis.text.y=element_text(size=20),axis.title=element_blank(),strip.text.x=element_text(size=20,face="bold"),strip.text.y=element_text(size=20,face="bold"))}如果 ((i==2)|(i==3)){P <- P + 主题(legend.position="none",axis.text.x=element_blank(),axis.text.y=element_blank(),axis.title=element_blank(),axis.ticks.x=element_blank(),axis.ticks.y=element_blank(),strip.text.x=element_text(size=20,face="bold"),strip.text.y=element_text(size=20,face="bold"))}如果 ((i==5)|(i==6)){P <- P + 主题(legend.position="none",axis.text.x=element_text(大小=20，角度=90，hjust=1)，axis.text.y=element_blank(),#axis.ticks.y=element_blank(), #为什么指定这个会产生错误?axis.title=element_blank(),axis.ticks.y=element_blank(),strip.text.x=element_text(size=20,face="bold"),strip.text.y=element_text(size=20,face="bold"))}#为什么使用下面的代码将数字更改为星号会出现错误?#P2 <- ggplot_build(P)#P2$data[[3]]$annotation <- rep(subset(pv.final0, p.value<=0.05)$map.signif, each=3)#P <- plot(ggplot_gtable(P2))sptr <- 粘贴(sp，tr)mylist[[sptr]] <- list(num.signif, P)}}返回(我的列表)}p.list2 <- plot.list2(mydf, pv.final, addkw, a, myPal)y.rng <- 范围(mydf$value)# 在所有三个方面"中获得最大数量的显着 p 值height.factor <- 0.5max.signif <- max(sapply(p.list2, function(x) x[[1]]))# 将三个图布置为面(每个物种一个)，但进行调整以使每个面的 y 范围相同.使用 max_signif 调整 y 范围的顶部.png(文件名=test2.png"，高度=800，宽度=1200)grid.arrange(grobs=lapply(p.list2, function(x) x[[2]] +scale_y_continuous(limits=c(y.rng[1], y.rng[2] + height.factor*max.signif))),ncol=length(unique(mydf$Species)), top="Random title", left="Value") #如何更改标题和 Y 轴文本的大小?#如何添加通用图例?dev.off()产生以下情节:
现在颜色问题更突出了，刻面高度不均匀，多余的刻面条文字也应该做一下.
我被困在这一点上，所以希望得到任何帮助.抱歉问了这么长的问题，但我认为它几乎就在那里！谢谢！！
解决方案
您可以尝试以下.由于您的代码真的很忙，而且对我来说太复杂而无法理解，我建议采用不同的方法.我试图避免循环并尽可能多地使用 tidyverse.因此，首先我创建了您的数据.然后计算 kruskal wallis 测试，因为这在 ggsignif 中是不可能的.之后我将使用 geom_signif 绘制所有 p.values.最后，将删除无关紧要的部分并添加步长.
1- 使着色工作完成
2- 显示星号而不是数字完成
...为了胜利:
3- 创造一个共同的传奇完成
4- 将 Kruskal-Wallis 线放在顶部完成，我将值放在底部
5- 更改标题和 y 轴文本的大小(和对齐方式)完成
图书馆(tidyverse)图书馆(ggsignif)# 1. 你的数据set.seed(2)df <- as.tbl(iris) %>%变异(治疗=代表(c(A"，B")，长度(鸢尾花物种)/2))%>%收集(键，值，-物种，-治疗)%>%变异(值=范数(n()))%>%变异(键=因子(键，级别=唯一(键)))%>%变异(两者=交互(治疗，关键，sep ="))# 2. 克鲁斯卡尔测试KW＜-df％＞％group_by(物种)%>%总结(p=round(kruskal.test(value ~ both)$p.value,2),y=min(值)，x=1)%＞%变异(y = min(y))# 3. 情节P＜-df％＞％ggplot(aes(x=both, y=value)) +geom_boxplot(aes(fill=Species)) +facet_grid(~物种) +ylim(-3,7)+主题(axis.text.x = element_text(angle=45, hjust=1)) +geom_signif(comparisons = combn(levels(df$both),2,simplify = F),map_signif_level = T) +stat_summary(fun.y=mean, geom="point", shape=5, size=4) +xlab("") +geom_text(data=KW,aes(x, y=y, label=paste0("KW p=",p)),hjust=0) +ggtitle("Plot") + ylab("这是我自己的 y-lab")# 4. 删除不重要的值并增加步长P_new <- ggplot_build(P)P_new$data[[2]] <- P_new$data[[2]] %>%过滤器(注释！=NS.")%>%group_by(PANEL)%>%变异(索引=(as.numeric(group[drop=T])-1)*0.5)%>%变异(y=y+index，日元=日元+指数)%>%选择(-索引)%>%as.data.frame()# 最后的情节情节(ggplot_gtable(P_new))和使用两个方面的类似方法
# --------------------# 5. 克鲁斯卡尔KW＜-df％＞％group_by(物种，治疗)％>％总结(p=round(kruskal.test(value ~ both)$p.value,2),y=min(值)，x=1)%＞%取消分组()%>%变异(y = min(y))# 6. 绘制两个面P＜-df％＞％ggplot(aes(x=key, y=value)) +geom_boxplot(aes(fill=Species)) +facet_grid(治疗~物种)+ylim(-5,7)+主题(axis.text.x = element_text(angle=45, hjust=1)) +geom_signif(comparisons = combn(levels(df$key),2,simplify = F),map_signif_level = T) +stat_summary(fun.y=mean, geom="point", shape=5, size=4) +xlab("") +geom_text(data=KW,aes(x, y=y, label=paste0("KW p=",p)),hjust=0) +ggtitle("Plot") + ylab("这是我自己的 y-lab")# 7. 删除不重要的值并增加步长P_new <- ggplot_build(P)P_new$data[[2]] <- P_new$data[[2]] %>%过滤器(注释！=NS.")%>%group_by(PANEL)%>%变异(索引=(as.numeric(group[drop=T])-1)*0.5)%>%变异(y=y+index，日元=日元+指数)%>%选择(-索引)%>%as.data.frame()# 最后的情节情节(ggplot_gtable(P_new))编辑.
根据你的p.adjust需求，你可以自己设置一个函数，直接在geom_signif()中调用.
wilcox.test.BH.adjusted <- function(x,y,n){tmp <- wilcox.test(x,y)tmp$p.value <- p.adjust(tmp$p.value, n = n,method = "BH")时间}geom_signif(comparisons = combn(levels(df$both),2,simplify = F),map_signif_level = T, test = "wilcox.test.BH.adjusted",test.args = list(n=8))挑战在于知道您最终将进行多少次独立测试.然后你可以自己设置n.这里我使用了 8.但这可能是错误的.
Following up on this question and for the sake of completeness, I modified the accepted answer and customized the resulting plot, but I am still facing some important problems.
To sum up, I am doing boxplots reflecting significance of Kruskal-Wallis and pairwise Wilcoxon test comparisons.
I want to replace the p-value numbers with asterisks, and show only the significant comparisons, reducing vertical spacing to the max.
Basically I want to do this, but with the added problem of facets, that messes everything up.
So far I have worked on a very decent MWE, but it still shows problems...
library(reshape2)
library(ggplot2)
library(gridExtra)
library(tidyverse)
library(data.table)
library(ggsignif)
library(RColorBrewer)
data(iris)
iris$treatment <- rep(c("A","B"), length(iris$Species)/2)
mydf <- melt(iris, measure.vars=names(iris)[1:4])
mydf$treatment <- as.factor(mydf$treatment)
mydf$variable <- factor(mydf$variable, levels=sort(levels(mydf$variable)))
mydf$both <- factor(paste(mydf$treatment, mydf$variable), levels=(unique(paste(mydf$treatment, mydf$variable))))
# Change data to reduce number of statistically significant differences
set.seed(2)
mydf <- mydf %>% mutate(value=rnorm(nrow(mydf)))
##
##FIRST TEST BOTH
#Kruskal-Wallis
addkw <- as.data.frame(mydf %>% group_by(Species) %>%
summarize(p.value = kruskal.test(value ~ both)$p.value))
#addkw$p.adjust <- p.adjust(addkw$p.value, "BH")
a <- combn(levels(mydf$both), 2, simplify = FALSE)
#new p.values
pv.final <- data.frame()
for (gr in unique(mydf$Species)){
for (i in 1:length(a)){
tis <- a[[i]] #variable pair to test
as <- subset(mydf, Species==gr & both %in% tis)
pv <- wilcox.test(value ~ both, data=as)$p.value
ddd <- data.table(as)
asm <- as.data.frame(ddd[, list(value=mean(value)), by=list(both=both)])
asm2 <- dcast(asm, .~both, value.var="value")[,-1]
pf <- data.frame(group1=paste(tis[1], gr), group2=paste(tis[2], gr), mean.group1=asm2[,1], mean.group2=asm2[,2], FC.1over2=asm2[,1]/asm2[,2], p.value=pv)
pv.final <- rbind(pv.final, pf)
}
}
#pv.final$p.adjust <- p.adjust(pv.final$p.value, method="BH")
pv.final$map.signif <- ifelse(pv.final$p.value > 0.05, "", ifelse(pv.final$p.value > 0.01,"*", "**"))
cols <- colorRampPalette(brewer.pal(length(unique(mydf$Species)), "Set1"))
myPal <- cols(length(unique(mydf$Species)))
#Function to get a list of plots to use as "facets" with grid.arrange
plot.list=function(mydf, pv.final, addkw, a, myPal){
mylist <- list()
i <- 0
for (sp in unique(mydf$Species)){
i <- i+1
mydf0 <- subset(mydf, Species==sp)
addkw0 <- subset(addkw, Species==sp)
pv.final0 <- pv.final[grep(sp, pv.final$group1), ]
num.signif <- sum(pv.final0$p.value <= 0.05)
P <- ggplot(mydf0,aes(x=both, y=value)) +
geom_boxplot(aes(fill=Species)) +
stat_summary(fun.y=mean, geom="point", shape=5, size=4) +
facet_grid(~Species, scales="free", space="free_x") +
scale_fill_manual(values=myPal[i]) + #WHY IS COLOR IGNORED?
geom_text(data=addkw0, hjust=0, size=4.5, aes(x=0, y=round(max(mydf0$value, na.rm=TRUE)+0.5), label=paste0("KW p=",p.value))) +
geom_signif(test="wilcox.test", comparisons = a[which(pv.final0$p.value<=0.05)],#I can use "a"here
map_signif_level = F,
vjust=0,
textsize=4,
size=0.5,
step_increase = 0.05)
if (i==1){
P <- P + theme(legend.position="none",
axis.text.x=element_text(size=20, angle=90, hjust=1),
axis.text.y=element_text(size=20),
axis.title=element_blank(),
strip.text.x=element_text(size=20,face="bold"),
strip.text.y=element_text(size=20,face="bold"))
} else{
P <- P + theme(legend.position="none",
axis.text.x=element_text(size=20, angle=90, hjust=1),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.title=element_blank(),
strip.text.x=element_text(size=20,face="bold"),
strip.text.y=element_text(size=20,face="bold"))
}
#WHY USING THE CODE BELOW TO CHANGE NUMBERS TO ASTERISKS I GET ERRORS?
#P2 <- ggplot_build(P)
#P2$data[[3]]$annotation <- rep(subset(pv.final0, p.value<=0.05)$map.signif, each=3)
#P <- plot(ggplot_gtable(P2))
mylist[[sp]] <- list(num.signif, P)
}
return(mylist)
}
p.list <- plot.list(mydf, pv.final, addkw, a, myPal)
y.rng <- range(mydf$value)
# Get the highest number of significant p-values across all three "facets"
height.factor <- 0.3
max.signif <- max(sapply(p.list, function(x) x[[1]]))
# Lay out the three plots as facets (one for each Species), but adjust so that y-range is same for each facet. Top of y-range is adjusted using max_signif.
png(filename="test.png", height=800, width=1200)
grid.arrange(grobs=lapply(p.list, function(x) x[[2]] +
scale_y_continuous(limits=c(y.rng[1], y.rng[2] + height.factor*max.signif))),
ncol=length(unique(mydf$Species)), top="Random title", left="Value") #HOW TO CHANGE THE SIZE OF THE TITLE AND THE Y AXIS TEXT?
#HOW TO ADD A COMMON LEGEND?
dev.off()
It produces the following plot:
As you can see there are some problems, most obviously:
1- Coloring does not work for some reason
2- I do not seem to be able to change the annotation with the asterisks
I want something more like this (mockup):
So we need to:
1- Make coloring work
2- Show asterisks instead of numbers
...and for the win:
3- Make a common legend
4- Place Kruskal-Wallis line on top
5- Change the size (and alignment) of the title and y axis text
IMPORTANT NOTES
I would appreciate my code is left as intact as possible even if it isn't the prettiest, cause I still have to make use of intermediate objects like "CNb" or "pv.final".
The solution should be easily transferable to other cases; please consider testing "variable" alone, instead of "both"... In this case we have 6 "facets" (vertically and horizontally) and everything gets even more screwed up...
I made this other MWE:
##NOW TEST MEASURE, TO GET VERTICAL AND HORIZONTAL FACETS
addkw <- as.data.frame(mydf %>% group_by(treatment, Species) %>%
summarize(p.value = kruskal.test(value ~ variable)$p.value))
#addkw$p.adjust <- p.adjust(addkw$p.value, "BH")
a <- combn(levels(mydf$variable), 2, simplify = FALSE)
#new p.values
pv.final <- data.frame()
for (tr in levels(mydf$treatment)){
for (gr in levels(mydf$Species)){
for (i in 1:length(a)){
tis <- a[[i]] #variable pair to test
as <- subset(mydf, treatment==tr & Species==gr & variable %in% tis)
pv <- wilcox.test(value ~ variable, data=as)$p.value
ddd <- data.table(as)
asm <- as.data.frame(ddd[, list(value=mean(value, na.rm=T)), by=list(variable=variable)])
asm2 <- dcast(asm, .~variable, value.var="value")[,-1]
pf <- data.frame(group1=paste(tis[1], gr, tr), group2=paste(tis[2], gr, tr), mean.group1=asm2[,1], mean.group2=asm2[,2], FC.1over2=asm2[,1]/asm2[,2], p.value=pv)
pv.final <- rbind(pv.final, pf)
}
}
}
#pv.final$p.adjust <- p.adjust(pv.final$p.value, method="BH")
# set signif level
pv.final$map.signif <- ifelse(pv.final$p.value > 0.05, "", ifelse(pv.final$p.value > 0.01,"*", "**"))
plot.list2=function(mydf, pv.final, addkw, a, myPal){
mylist <- list()
i <- 0
for (sp in unique(mydf$Species)){
for (tr in unique(mydf$treatment)){
i <- i+1
mydf0 <- subset(mydf, Species==sp & treatment==tr)
addkw0 <- subset(addkw, Species==sp & treatment==tr)
pv.final0 <- pv.final[grep(paste(sp,tr), pv.final$group1), ]
num.signif <- sum(pv.final0$p.value <= 0.05)
P <- ggplot(mydf0,aes(x=variable, y=value)) +
geom_boxplot(aes(fill=Species)) +
stat_summary(fun.y=mean, geom="point", shape=5, size=4) +
facet_grid(treatment~Species, scales="free", space="free_x") +
scale_fill_manual(values=myPal[i]) + #WHY IS COLOR IGNORED?
geom_text(data=addkw0, hjust=0, size=4.5, aes(x=0, y=round(max(mydf0$value, na.rm=TRUE)+0.5), label=paste0("KW p=",p.value))) +
geom_signif(test="wilcox.test", comparisons = a[which(pv.final0$p.value<=0.05)],#I can use "a"here
map_signif_level = F,
vjust=0,
textsize=4,
size=0.5,
step_increase = 0.05)
if (i==1){
P <- P + theme(legend.position="none",
axis.text.x=element_blank(),
axis.text.y=element_text(size=20),
axis.title=element_blank(),
axis.ticks.x=element_blank(),
strip.text.x=element_text(size=20,face="bold"),
strip.text.y=element_text(size=20,face="bold"))
}
if (i==4){
P <- P + theme(legend.position="none",
axis.text.x=element_text(size=20, angle=90, hjust=1),
axis.text.y=element_text(size=20),
axis.title=element_blank(),
strip.text.x=element_text(size=20,face="bold"),
strip.text.y=element_text(size=20,face="bold"))
}
if ((i==2)|(i==3)){
P <- P + theme(legend.position="none",
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.title=element_blank(),
axis.ticks.x=element_blank(),
axis.ticks.y=element_blank(),
strip.text.x=element_text(size=20,face="bold"),
strip.text.y=element_text(size=20,face="bold"))
}
if ((i==5)|(i==6)){
P <- P + theme(legend.position="none",
axis.text.x=element_text(size=20, angle=90, hjust=1),
axis.text.y=element_blank(),
#axis.ticks.y=element_blank(), #WHY SPECIFYING THIS GIVES ERROR?
axis.title=element_blank(),
axis.ticks.y=element_blank(),
strip.text.x=element_text(size=20,face="bold"),
strip.text.y=element_text(size=20,face="bold"))
}
#WHY USING THE CODE BELOW TO CHANGE NUMBERS TO ASTERISKS I GET ERRORS?
#P2 <- ggplot_build(P)
#P2$data[[3]]$annotation <- rep(subset(pv.final0, p.value<=0.05)$map.signif, each=3)
#P <- plot(ggplot_gtable(P2))
sptr <- paste(sp,tr)
mylist[[sptr]] <- list(num.signif, P)
}
}
return(mylist)
}
p.list2 <- plot.list2(mydf, pv.final, addkw, a, myPal)
y.rng <- range(mydf$value)
# Get the highest number of significant p-values across all three "facets"
height.factor <- 0.5
max.signif <- max(sapply(p.list2, function(x) x[[1]]))
# Lay out the three plots as facets (one for each Species), but adjust so that y-range is same for each facet. Top of y-range is adjusted using max_signif.
png(filename="test2.png", height=800, width=1200)
grid.arrange(grobs=lapply(p.list2, function(x) x[[2]] +
scale_y_continuous(limits=c(y.rng[1], y.rng[2] + height.factor*max.signif))),
ncol=length(unique(mydf$Species)), top="Random title", left="Value") #HOW TO CHANGE THE SIZE OF THE TITLE AND THE Y AXIS TEXT?
#HOW TO ADD A COMMON LEGEND?
dev.off()
That produces the following plot:
Now the color problem becomes more striking, the facet heights are uneven, and something should be done with the redundant facet strip texts too.
I am stuck at this point, so would appreciate any help. Sorry for the long question, but I think it is almost there! Thanks!!
解决方案
You can try following. As your code is really busy and for me too complicated to understand, I suggest a different approach. I tried to avoid loops and to use the tidyverse as much as possible. Thus, first I created your data. Then calculated kruskal wallis tests as this was not possible within ggsignif. Afterwards I will plot all p.values using geom_signif. Finally, insignificant ones will be removed and a step increase is added.
1- Make coloring work done
2- Show asterisks instead of numbers done
...and for the win:
3- Make a common legend done
4- Place Kruskal-Wallis line on top done, I placed the values at the bottom
5- Change the size (and alignment) of the title and y axis text done
library(tidyverse)
library(ggsignif)
# 1. your data
set.seed(2)
df <- as.tbl(iris) %>%
mutate(treatment=rep(c("A","B"), length(iris$Species)/2)) %>%
gather(key, value, -Species, -treatment) %>%
mutate(value=rnorm(n())) %>%
mutate(key=factor(key, levels=unique(key))) %>%
mutate(both=interaction(treatment, key, sep = " "))
# 2. Kruskal test
KW <- df %>%
group_by(Species) %>%
summarise(p=round(kruskal.test(value ~ both)$p.value,2),
y=min(value),
x=1) %>%
mutate(y=min(y))
# 3. Plot
P <- df %>%
ggplot(aes(x=both, y=value)) +
geom_boxplot(aes(fill=Species)) +
facet_grid(~Species) +
ylim(-3,7)+
theme(axis.text.x = element_text(angle=45, hjust=1)) +
geom_signif(comparisons = combn(levels(df$both),2,simplify = F),
map_signif_level = T) +
stat_summary(fun.y=mean, geom="point", shape=5, size=4) +
xlab("") +
geom_text(data=KW,aes(x, y=y, label=paste0("KW p=",p)),hjust=0) +
ggtitle("Plot") + ylab("This is my own y-lab")
# 4. remove not significant values and add step increase
P_new <- ggplot_build(P)
P_new$data[[2]] <- P_new$data[[2]] %>%
filter(annotation != "NS.") %>%
group_by(PANEL) %>%
mutate(index=(as.numeric(group[drop=T])-1)*0.5) %>%
mutate(y=y+index,
yend=yend+index) %>%
select(-index) %>%
as.data.frame()
# the final plot
plot(ggplot_gtable(P_new))
and similar approach using two facets
# --------------------
# 5. Kruskal
KW <- df %>%
group_by(Species, treatment) %>%
summarise(p=round(kruskal.test(value ~ both)$p.value,2),
y=min(value),
x=1) %>%
ungroup() %>%
mutate(y=min(y))
# 6. Plot with two facets
P <- df %>%
ggplot(aes(x=key, y=value)) +
geom_boxplot(aes(fill=Species)) +
facet_grid(treatment~Species) +
ylim(-5,7)+
theme(axis.text.x = element_text(angle=45, hjust=1)) +
geom_signif(comparisons = combn(levels(df$key),2,simplify = F),
map_signif_level = T) +
stat_summary(fun.y=mean, geom="point", shape=5, size=4) +
xlab("") +
geom_text(data=KW,aes(x, y=y, label=paste0("KW p=",p)),hjust=0) +
ggtitle("Plot") + ylab("This is my own y-lab")
# 7. remove not significant values and add step increase
P_new <- ggplot_build(P)
P_new$data[[2]] <- P_new$data[[2]] %>%
filter(annotation != "NS.") %>%
group_by(PANEL) %>%
mutate(index=(as.numeric(group[drop=T])-1)*0.5) %>%
mutate(y=y+index,
yend=yend+index) %>%
select(-index) %>%
as.data.frame()
# the final plot
plot(ggplot_gtable(P_new))
Edit.
Regarding to your p.adjust needs, you can set up a function on your own and calling it directly within geom_signif().
wilcox.test.BH.adjusted <- function(x,y,n){
tmp <- wilcox.test(x,y)
tmp$p.value <- p.adjust(tmp$p.value, n = n,method = "BH")
tmp
}
geom_signif(comparisons = combn(levels(df$both),2,simplify = F),
map_signif_level = T, test = "wilcox.test.BH.adjusted",
test.args = list(n=8))
The challenge is to know how many independet tests you will have in the end. Then you can set the n by your own. Here I used 8. But this is maybe wrong.
这篇关于具有 Wilcoxon 显着性水平和方面的箱线图仅显示与星号的显着比较的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
