r - 如何使用 ggplot 在多面 R 图的各面之间添加重要括号？

Question

我使用以下代码通过 facet_grid() 选项绘制纵向数据。我想使用括号和星号来指示分面网格之间的显着组差异。但是，到目前为止，我只能在各个网格内添加文本/线条，而不能在它们之间添加文本/线条。

for(i in seq_along(varlist)){
    p <- ggplot(data = Plot, aes(x = Timepoint , y = eval(parse(text = varlist[i])), 
                group = Sub_ID, colour = Subgroup)) + geom_point() +
                geom_line(linetype = "dashed")

    r <- p + stat_smooth(aes(group = 1, method = "lm")) + stat_summary(aes(group = 1),
         geom = "point", fun.y = mean, shape = 17, size = 5)  + facet_grid(. ~ Subgroup)

    ggsave(filename=paste(varlist[i],"_by_subgroup.jpg", sep=""),width = 10, height = 7.5) 
}

Answer 1

加载库

require(data.table)
require(ggplot2)
require(gtable)

制作玩具数据

data0 <- data.table(iris)[,list(Mean.Sepal.Length=mean(.SD[,Sepal.Length]),Mean.Petal.Length=mean(.SD[,Petal.Length])),by=list(Species)]
data1 <- melt(data0,id.vars="Species")

## ## Draw the bars
p <- ggplot(data=data1,aes(x=variable,y=value,fill=variable)) +
  geom_bar(stat="identity") +
  facet_grid(~Species) +
  scale_x_discrete(breaks=NULL)
p

画出括号和星号

## make function to rescale the coordinates to npc
scale_to_npc <- function(x, range) scales::rescale(c(range, x), c(0,1))[-c(1,2)]
scale_x <- function(x,facet,ranges){scale_to_npc(x,ranges[[facet]][["x.range"]])}
scale_y <- function(y,facet,ranges){scale_to_npc(y,ranges[[facet]][["y.range"]])}

## build grobs and get the ranges
gb <- ggplot_build(p)
g <- ggplot_gtable(gb)
## gtable_show_layout(g)
ranges <- gb$panel$ranges


## get and rescale the coordinates 
y1 <- data1[variable=="Mean.Petal.Length",min(value)]
y3 <- data1[,max(value)]
y4 <- data1[variable=="Mean.Petal.Length",max(value)]
data2 <- data.frame(x.=c(2,2,2,2,1.5),y.=c(y1,y3*1.01,y3*1.01,y4,y3*1.01),facet=c(1,1,3,3,2))
data2b <- data.frame(
  x=mapply(scale_x,data2[,1],data2[,3],MoreArgs=list(ranges =ranges)),
  y=mapply(scale_y,data2[,2],data2[,3],MoreArgs=list(ranges=ranges))
  )

## draw the brackets and asterisks
g <- gtable_add_grob(g, moveToGrob(data2b[1,1],data2b[1,2]),t=4,l=4,b=4,r=4)
g <- gtable_add_grob(g, lineToGrob(data2b[2,1],data2b[2,2]),t=4.5,l=4,b=4,r=4)
g <- gtable_add_grob(g, moveToGrob(data2b[2,1],data2b[2,2]),t=4.5,l=4,b=4,r=4)
g <- gtable_add_grob(g, lineToGrob(data2b[3,1],data2b[3,2]),t=4,l=8,b=4,r=8)
g <- gtable_add_grob(g, moveToGrob(data2b[3,1],data2b[3,2]),t=4,l=8,b=4,r=8)
g <- gtable_add_grob(g, lineToGrob(data2b[4,1],data2b[4,2]),t=4.5,l=8,b=4,r=8)
g <- gtable_add_grob(g, textGrob("***",data2b[5,1],data2b[5,2]),t=4,l=4,b=4,r=8)

## turn clip off to allow the line across panels
g$layout$clip <- "off"
grid.newpage()
grid.draw(g)