2016-05-11 26 views
1

我正在使用以下代码以facet_grid()选项绘制纵向数据。我想指出使用括号和星号的方面网格之间之间的重大群体差异。但是,到目前为止,我只能在单个网格中添加文本/线条,而不是在它们之间。如何在使用ggplot的刻面R图的刻面之间添加重要的括号?

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

你也可以提供一些数据与你的代码。参考:http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example?lq=1 – Technophobe01

+1

可能想看看gridExtra。手动创建方面,然后将括号添加为额外的grobs。如果不了解更多关于您要查找的内容/获取某些数据的信息,则很难提出具体的解决方案。看到这里:https://cran.r-project.org/web/packages/gridExtra/vignettes/arrangeGrob.html – triddle

回答

2

装入库

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) 

enter image description here