ggplot barplots और boxplots पर सितारों को रखें - महत्व के स्तर को इंगित करने के लिए (पी-मान)

Question

सितारों को एक या दो समूहों के बीच महत्व (पी-वैल्यू) के स्तर को दिखाने के लिए बार्प्लॉट्स या बॉक्सप्लॉट्स पर रखना आम बात है कई उदाहरण हैं:

उदाहरण के लिए एक पी-मूल्य के लिए 3 सितारों डाल सकते हैं सितारों की संख्या, पी-मूल्य द्वारा परिभाषित कर रहे < 0.001, पी-मूल्य < 0.01 के लिए दो सितारों, और तो (हालांकि यह एक लेख से दूसरे में बदलता है)।

और मेरे प्रश्न: समान चार्ट कैसे उत्पन्न करें? महत्व स्तर के आधार पर स्वचालित रूप से तारों को रखने वाले विधियां स्वागत से अधिक हैं।

Answer 1

कृपया नीचे अपना प्रयास ढूंढें।

पहले, मैं कुछ डमी डेटा और एक barplot जो के रूप में हम चाहते हैं संशोधित किया जा सकता बनाया।

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) 

कॉलम के ऊपर तारांकन जोड़ना आसान है, क्योंकि बैपटिस्ट पहले ही उल्लेख कर चुका है। निर्देशांक के साथ बस data.frame बनाएं।

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

p + geom_text(data = label.df, label = "***") 

आर्क्स कि एक उपसमूह तुलना से संकेत मिलता है जोड़ने के लिए, मैं एक आधा चक्र के पैरामीट्रिक निर्देशांक गणना की और उन्हें geom_line के साथ जुड़ा हुआ गयी। क्षुद्रग्रहों को भी नए निर्देशांक की आवश्यकता होती है।

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) 

आखिरकार, समूहों के बीच तुलना इंगित करने के लिए, मैंने एक बड़ा सर्कल बनाया और इसे शीर्ष पर चपटा।

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 = "***") 

Answer 2

मुझे पता है कि यह एक पुराना प्रश्न है और जेन्स टियरलिंग द्वारा उत्तर पहले ही समस्या का समाधान प्रदान करता है। लेकिन मैं हाल ही में एक ggplot-विस्तार है जो जोड़ने महत्व सलाखों के पूरी प्रक्रिया को सरल बनाया:

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) 

: उबाते geom_line और geom_text जोड़ने अपने भूखंड के लिए करने के बजाय ggsignif

तुम सिर्फ एक परत geom_signif जोड़ने

एक और अधिक उन्नत साजिश जेन्स Tierling द्वारा दिखाए गए के समान बनाने के लिए, आप कर सकते हैं:

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")) 

पैकेज के सभी दस्तावेज़ CRAN पर उपलब्ध है।

Answer 3

ggsignif पैकेज का एक विस्तार भी है जिसे ggpubr कहा जाता है जो बहु-समूह तुलनाओं की बात करते समय अधिक शक्तिशाली होता है। यह ggsignif के शीर्ष पर बनाता है, लेकिन यह भी एनोवा और कुर्स्कल-वालिस को संभालने के साथ-साथ ग्लोबल माध्य के खिलाफ जोड़ी तुलना करता है।

उदाहरण:

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) 

Answer 4

अपने ही समारोह निर्मित:

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) 
} 

डाटा और कॉल:

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) 

परिणाम: