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)