Coloca estrellas en las gráficas de barras ggplot y en las gráficas de caja: para indicar el nivel de significancia (valor p)

Es común poner estrellas en las barras diagonales o en las gráficas de caja para mostrar el nivel de significancia (valor p) de uno o entre dos grupos, a continuación hay varios ejemplos:

enter image description hereenter image description hereenter image description here

El número de estrellas se define por el valor p, por ejemplo, se pueden poner 3 estrellas para el valor p <0.001, dos estrellas para el valor p <0.01, y así sucesivamente (aunque esto cambia de un artículo a otro).

Y mis preguntas: ¿cómo generar gráficos similares? Los métodos que automáticamente colocan a las estrellas según el nivel de significancia son más que bienvenidos.

Por favor encuentra mi bash a continuación.

Ejemplo de diagrama

Primero, creé algunos datos ficticios y un diagtwig de barra que se puede modificar como lo deseamos.

windows(4,4) dat <- data.frame(Group = c("S1", "S1", "S2", "S2"), Sub = c("A", "B", "A", "B"), Value = c(3,5,7,8)) ## Define base plot p <- ggplot(dat, aes(Group, Value)) + theme_bw() + theme(panel.grid = element_blank()) + coord_cartesian(ylim = c(0, 15)) + scale_fill_manual(values = c("grey80", "grey20")) + geom_bar(aes(fill = Sub), stat="identity", position="dodge", width=.5) 

Agregar asteriscos por encima de una columna es fácil, como ya mencionó el bautista. Simplemente crea un data.frame con las coordenadas.

 label.df <- data.frame(Group = c("S1", "S2"), Value = c(6, 9)) p + geom_text(data = label.df, label = "***") 

Para agregar los arcos que indican una comparación de subgrupos, calculé las coordenadas paramétricas de un medio círculo y las agregué conectadas con geom_line . Los asteriscos necesitan nuevas coordenadas, también.

 label.df <- data.frame(Group = c(1,1,1, 2,2,2), Value = c(6.5,6.8,7.1, 9.5,9.8,10.1)) # Define arc coordinates r <- 0.15 t <- seq(0, 180, by = 1) * pi / 180 x <- r * cos(t) y <- r*5 * sin(t) arc.df <- data.frame(Group = x, Value = y) p2 <- p + geom_text(data = label.df, label = "*") + geom_line(data = arc.df, aes(Group+1, Value+5.5), lty = 2) + geom_line(data = arc.df, aes(Group+2, Value+8.5), lty = 2) 

Por último, para indicar la comparación entre grupos, construí un círculo más grande y lo aplasté en la parte superior.

 r <- .5 x <- r * cos(t) y <- r*4 * sin(t) y[20:162] <- y[20] # Flattens the arc arc.df <- data.frame(Group = x, Value = y) p2 + geom_line(data = arc.df, aes(Group+1.5, Value+11), lty = 2) + geom_text(x = 1.5, y = 12, label = "***") 

Sé que esta es una vieja pregunta y la respuesta de Jens Tierling ya proporciona una solución para el problema. Pero recientemente creé una ggplot-extensión que simplifica todo el proceso de agregar barras de significación: ggsignif

En lugar de agregar tediosamente geom_line y geom_text a su ttwig, simplemente agrega una sola capa geom_signif :

 library(ggplot2) library(ggsignif) ggplot(iris, aes(x=Species, y=Sepal.Length)) + geom_boxplot() + geom_signif(comparisons = list(c("versicolor", "virginica")), map_signif_level=TRUE) 

Boxplot con barra de significancia

Para crear una ttwig más avanzada similar a la mostrada por Jens Tierling, puede hacer:

 dat <- data.frame(Group = c("S1", "S1", "S2", "S2"), Sub = c("A", "B", "A", "B"), Value = c(3,5,7,8)) ggplot(dat, aes(Group, Value)) + geom_bar(aes(fill = Sub), stat="identity", position="dodge", width=.5) + geom_signif(stat="identity", data=data.frame(x=c(0.875, 1.875), xend=c(1.125, 2.125), y=c(5.8, 8.5), annotation=c("**", "NS")), aes(x=x,xend=xend, y=y, yend=y, annotation=annotation)) + geom_signif(comparisons=list(c("S1", "S2")), annotations="***", y_position = 9.3, tip_length = 0, vjust=0.4) + scale_fill_manual(values = c("grey80", "grey20")) 

enter image description here

La documentación completa del paquete está disponible en CRAN .

También hay una extensión del paquete ggsignif llamada ggpubr que es más poderosa cuando se trata de comparaciones de múltiples grupos. Se basa en ggsignif, pero también maneja anova y kruskal-wallis, así como comparaciones por pares en comparación con el promedio gobal.

Ejemplo:

 ggboxplot(ToothGrowth, x = "dose", y = "len", color = "dose", palette = "jco")+ stat_compare_means(comparisons = my_comparisons, label.y = c(29, 35, 40))+ stat_compare_means(label.y = 45) 

enter image description here

Hice mi propia función:

 ts_test <- function(dataL,x,y,method="t.test",idCol=NULL,paired=F,label = "p.signif",p.adjust.method="none",alternative = c("two.sided", "less", "greater"),...) { options(scipen = 999) annoList <- list() setDT(dataL) if(paired) { allSubs <- dataL[,.SD,.SDcols=idCol] %>% na.omit %>% unique dataL <- dataL[,merge(.SD,allSubs,by=idCol,all=T),by=x] #idCol!!! } if(method =="t.test") { dataA <- eval(parse(text=paste0( "dataL[,.(",as.name(y),"=mean(get(y),na.rm=T),sd=sd(get(y),na.rm=T)),by=x] %>% setDF" ))) res<-pairwise.t.test(x=dataL[[y]], g=dataL[[x]], p.adjust.method = p.adjust.method, pool.sd = !paired, paired = paired, alternative = alternative, ...) } if(method =="wilcox.test") { dataA <- eval(parse(text=paste0( "dataL[,.(",as.name(y),"=median(get(y),na.rm=T),sd=IQR(get(y),na.rm=T,type=6)),by=x] %>% setDF" ))) res<-pairwise.wilcox.test(x=dataL[[y]], g=dataL[[x]], p.adjust.method = p.adjust.method, paired = paired, ...) } #Output the groups res$p.value %>% dimnames %>% {paste(.[[2]],.[[1]],sep="_")} %>% cat("Groups ",.) #Make annotations ready annoList[["label"]] <- res$p.value %>% diag %>% round(5) if(!is.null(label)) { if(label == "p.signif"){ annoList[["label"]] %<>% cut(.,breaks = c(-0.1, 0.0001, 0.001, 0.01, 0.05, 1), labels = c("****", "***", "**", "*", "ns")) %>% as.character } } annoList[["x"]] <- dataA[[x]] %>% {diff(.)/2 + .[-length(.)]} annoList[["y"]] <- {dataA[[y]] + dataA[["sd"]]} %>% {pmax(lag(.), .)} %>% na.omit #Make plot coli="#0099ff";sizei=1.3 p <-ggplot(dataA, aes(x=get(x), y=get(y))) + geom_errorbar(aes(ymin=len-sd, ymax=len+sd),width=.1,color=coli,size=sizei) + geom_line(color=coli,size=sizei) + geom_point(color=coli,size=sizei) + scale_color_brewer(palette="Paired") + theme_minimal() + xlab(x) + ylab(y) + ggtitle("title","subtitle") #Annotate significances p <-p + annotate("text", x = annoList[["x"]], y = annoList[["y"]], label = annoList[["label"]]) return(p) } 

Datos y llamada:

 library(ggplot2);library(data.table);library(magrittr); df_long <- rbind(ToothGrowth[,-2],data.frame(len=40:50,dose=3.0)) df_long$ID <- data.table::rowid(df_long$dose) ts_test(dataL=df_long,x="dose",y="len",idCol="ID",method="wilcox.test",paired=T) 

Resultado:

enter image description here