调整lapply生成的多个图的宽度，rangingGrob

Question

我有下面的绘图代码：我的问题是如何调整图中第一个绘图和最后一个绘图的宽度？

dat=data.frame(x=rep(c("M","D"),each=60),y=rep(rep(c(4,6,8,10,12),each=12),2),z=runif(120,0,100),s=rep(c(1:4),each=3,len=120))

gp=lapply(split(dat,dat$y),function(dfr){
  g=ggplot(data = dfr, aes(s,z)) + 
    geom_point(aes(shape=x,colour=x),size=4)+
    ylim(0,100)+
    xlab("Int segs")+
    ggtitle(paste(dfr[1,2],"hours"))
  return(g)})
tiff(file="Pas.tiff",width=60, height = 22,units="cm",res=300)
require(gridExtra)
rg=arrangeGrob(grobs=list(gp$`4` + theme(legend.position="none"),
                          gp$`6` + theme(legend.position="none",
                                         axis.title.y = element_blank(),
                                         axis.text.y = element_blank()),
                          gp$`8` + theme(legend.position="none",
                                         axis.title.y = element_blank(),
                                         axis.text.y = element_blank()),
                          gp$`10` + theme(legend.position="none",
                                          axis.title.y = element_blank(),
                                          axis.text.y = element_blank()),
                          gp$`12` + theme(axis.title.y = element_blank(),
                                          axis.text.y = element_blank())),ncol=5,
               top=textGrob("Pas rate",
                            gp=gpar(fontsize=20,fontface="bold"),
                            y = unit(.4, "cm")),
               theme(margin(t=70,r=0.2,b=0.5,l=0.3,unit="mm")))

grid.newpage()
#grid.draw(cbind(lg, rg, size = "last"))
grid.draw(rg)
dev.off()

Answer 1

我建议您使用gtable ：您可以从第一个“虚拟”图提取图例和y.label，然后以相同的尺寸在一个单元格内绘制每个图（已从所有图例中删除了图例和y.label，包括第一个最后），然后将y.label和图例添加到单独的单元格中。

require(ggplot2)
require(gtable)
require(grid)
library(dplyr)
library(scales)

dat <- data.frame(x=rep(c("M","D"),each=60),
                  y=rep(rep(c(4,6,8,10,12),each=12),2),
                  z=runif(120,0,100),
                  s=rep(c(1:4),each=3,len=120))

gp <- lapply(split(dat,dat$y),function(dfr){
    g=ggplot(data = dfr, aes(s,z)) + 
        geom_point(aes(shape=x,colour=x),size=4)+
        ylim(0,100)+
        xlab("Int segs")+
        ggtitle(paste(dfr[1,2],"hours"))
    return(g)
})


tiff(file="Pas.tiff",width=60, height = 22,units="cm",res=300)

## Step 1:
## "dummy" plot, just to take y axis title/text and legend
dummy <- ggplotGrob(gp[[1]] + theme(panel.background = element_blank()))$grobs
legend <- dummy[[which(sapply(dummy, function(x) x$name) == "guide-box")]]
ytitle <- dummy[[grep("axis.title.y",sapply(dummy, function(x) x$name))]]
yticks <- dummy[[2]]

## Step 2:
## actual plots, all of them without y axis title/text and legend
pp <- 1
tab <- ggplotGrob(gp[[pp]] + theme(legend.position="none",
                                   axis.title.y = element_blank(),
                                   axis.text.y = element_blank()))
for(pp in 2:length(gp)){
    tab <- gtable_add_cols(tab, unit(1,"null"))
    tab <- gtable_add_grob(tab, ggplotGrob(gp[[pp]] + theme(legend.position="none",
                                                            axis.title.y = element_blank(),
                                                            axis.text.y = element_blank())), 
                           t = 1, l = ncol(tab), b=nrow(tab), r=ncol(tab))
}

## Step 2:
## adding back ytitle, yticks and legend
## add narrow column to the left and put yticks labels withint
tab <- gtable_add_cols(tab, unit(1,"cm"), pos=0)
tab <- gtable_add_grob(tab, yticks, 
                       t = 3, l = 2, b=nrow(tab)-3, r=1)

## add narrow column to the left and put y.axis label withint
ab <- gtable_add_cols(tab, unit(1,"cm"), pos=0)
tab <- gtable_add_grob(tab, ytitle, 
                       t = 1, l = 1, b=nrow(tab), r=1)

## add narrow column to the right and put legend within
tab <- gtable_add_cols(tab, unit(1.5,"cm"))
tab <- gtable_add_grob(tab, legend, 
                       t = 1, l = ncol(tab), b=nrow(tab), r=ncol(tab))
grid.newpage()
grid.draw(tab)
dev.off()

Answer 2

我会在这里使用cbind（）（如果无法选择faceting）

gp[[1]] <- gp[[1]] + theme(legend.position="none")
gp[[5]] <- gp[[5]] + theme(axis.title.y = element_blank(),
                             axis.text.y = element_blank())
gp[c("6", "8", "10")] <- lapply(gp[c("6", "8", "10")], "+", e2 = theme(legend.position="none",
                                                                       axis.title.y = element_blank(),
                                                                       axis.text.y = element_blank()))

grid.newpage()
grid.draw(do.call(gridExtra::cbind.gtable, lapply(gp, ggplotGrob)))