ggplot2 boxplots - 如果没有重要的比较,如何避免额外的垂直空间？

Question

在关于如何制作具有方面和显着性水平的箱形图的许多问题之后,特别是这个和这个,我还有一个小问题.

我设法制作了如下所示的情节,这正是我想要的.

我现在面临的问题是,我很少或没有重要的比较; 在这些情况下,专用于显示显着性水平的括号的整个空间仍然保留,但我想摆脱它.

请使用iris数据集检查此MWE:

library(reshape2)
library(ggplot2)
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))))
a <- combn(levels(mydf$both), 2, simplify = FALSE)#this 6 times, for each lipid class
b <- levels(mydf$Species)
CNb <- relist(
    paste(unlist(a), rep(b, each=sum(lengths(a)))), 
    rep.int(a, length(b))
)
CNb
CNb2 <- data.frame(matrix(unlist(CNb), ncol=2, byrow=T))
CNb2
#new p.values
pv.df <- 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], log.FC.1over2=log2(asm2[,1]/asm2[,2]), p.value=pv)
        pv.df <- rbind(pv.df, pf)
    }
}
pv.df$p.adjust <- p.adjust(pv.df$p.value, method="BH")
colnames(CNb2) <- colnames(pv.df)[1:2]
# merge with the CN list
pv.final <- merge(CNb2, pv.df, by.x = c("group1", "group2"), by.y = c("group1", "group2"))
# fix ordering
pv.final <- pv.final[match(paste(CNb2$group1, CNb2$group2), paste(pv.final$group1, pv.final$group2)),]
# set signif level
pv.final$map.signif <- ifelse(pv.final$p.adjust > 0.05, "", ifelse(pv.final$p.adjust > 0.01,"*", "**"))
# subset
G <- pv.final$p.adjust <= 0.05
CNb[G]
P <- ggplot(mydf,aes(x=both, y=value)) +
    geom_boxplot(aes(fill=Species)) +
    facet_grid(~Species, scales="free", space="free_x") +
    theme(axis.text.x = element_text(angle=45, hjust=1)) +
    geom_signif(test="wilcox.test", comparisons = combn(levels(mydf$both),2, simplify = F),
              map_signif_level = F,            
              vjust=0.5,
              textsize=4,
              size=0.5,
              step_increase = 0.06)
P2 <- ggplot_build(P)

#pv.final$map.signif <- "" #UNCOMMENT THIS LINE TO MOCK A CASE WHERE THERE ARE NO SIGNIFICANT COMPARISONS
#pv.final$map.signif[c(1:42,44:80,82:84)] <- "" #UNCOMMENT THIS LINE TO MOCK A CASE WHERE THERE ARE JUST A COUPLE OF SIGNIFICANT COMPARISONS

P2$data[[2]]$annotation <- rep(pv.final$map.signif, each=3)
# remove non significants
P2$data[[2]] <- P2$data[[2]][P2$data[[2]]$annotation != "",]
# and the final plot
png(filename="test.png", height=800, width=800)
  plot(ggplot_gtable(P2))
dev.off()

这产生了这个情节:

上面的情节正是我想要的......但我面临的情况是没有重要的比较,或者很少.在这些情况下,许多垂直空间都是空的.

为了举例说明这些情况,我们可以取消注释该行:

pv.final$map.signif <- "" #UNCOMMENT THIS LINE TO MOCK A CASE WHERE THERE ARE NO SIGNIFICANT COMPARISONS

因此,当没有重要的比较时,我会得到这个情节:

如果我们取消注释另一行:

pv.final$map.signif[c(1:42,44:80,82:84)] <- "" #UNCOMMENT THIS LINE TO MOCK A CASE WHERE THERE ARE JUST A COUPLE OF SIGNIFICANT COMPARISONS

我们的情况只有几个重要的比较,并获得这个情节:

所以我的问题是:

如何将垂直空间调整为重要比较的数量,因此没有垂直空间？

可能有一些东西我可以step_increase在y_position内部或里面改变geom_signif(),所以我只留下空间用于重要的比较CNb[G]......

Answer 1

一种选择是预先计算每个both级别组合的p值,然后仅选择重要的级别用于绘图.由于我们事先知道有多少是重要的,我们可以调整图的y范围来解释这个问题.但是,它看起来不能geom_signif仅对p值注释进行内部计算(请参阅manual参数的帮助).因此,我们不是使用ggplot的faceting,而是使用lapply为每个创建一个单独的绘图Species,然后grid.arrange从gridExtra包中使用来布置各个绘图,就好像它们是刻面的一样.

(为了回应这些评论,我想强调的是,这些图仍然是用ggplot2创建的,但是我们创建了一个单独的图的三个面板作为三个单独的图,然后将它们放在一起就好像它们一样面对面.)

下面的函数是对OP中的数据框和列名进行硬编码,但当然可以推广为采用任何数据框和列名.

library(gridExtra)
library(tidyverse)

# Change data to reduce number of statistically significant differences
set.seed(2)
df = mydf %>% mutate(value=rnorm(nrow(mydf)))

# Function to generate and lay out the plots
signif_plot = function(signif.cutoff=0.05, height.factor=0.23) {

  # Get full range of y-values
  y_rng = range(df$value)

  # Generate a list of three plots, one for each Species (these are the facets)
  plot_list = lapply(split(df, df$Species), function(d) {

    # Get pairs of x-values for current facet
    pairs = combn(sort(as.character(unique(d$both))), 2, simplify=FALSE)

    # Run wilcox test on every pair
    w.tst =  pairs %>% 
      map_df(function(lv) { 
        p.value = wilcox.test(d$value[d$both==lv[1]], d$value[d$both==lv[2]])$p.value
        data.frame(levs=paste(lv, collapse=" "), p.value)
      })

    # Record number of significant p.values. We'll use this later to adjust the top of the
    # y-range of the plots
    num_signif = sum(w.tst$p.value <= signif.cutoff)

    # Plot significance levels only for combinations with p <= signif.cutoff
    p = ggplot(d, aes(x=both, y=value)) +
      geom_boxplot() +
      facet_grid(~Species, scales="free", space="free_x") +
      geom_signif(test="wilcox.test", comparisons = pairs[which(w.tst$p.value <= signif.cutoff)],
                  map_signif_level = F,            
                  vjust=0,
                  textsize=3,
                  size=0.5,
                  step_increase = 0.08) +
      theme_bw() +
      theme(axis.title=element_blank(),
            axis.text.x = element_text(angle=45, hjust=1))

    # Return the plot and the number of significant p-values
    return(list(num_signif, p))
  })

  # Get the highest number of significant p-values across all three "facets"
  max_signif = max(sapply(plot_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.
  grid.arrange(grobs=lapply(plot_list, function(x) x[[2]] + 
                              scale_y_continuous(limits=c(y_rng[1], y_rng[2] + height.factor*max_signif))), 
               ncol=3, left="Value")
}

现在运行具有四个不同显着截止值的函数:

signif_plot(0.05)

signif_plot(0.01)

signif_plot(0.9)

signif_plot(0.0015)