Настройте ширину нескольких участков, сделанных lapply, arrGrob

Question

У меня есть код для создания следующих участков: . Мой вопрос в том, как настроить ширину 1-го участка и последний график на рисунке?

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

я хотел бы использовать cbind() здесь (если facetting это не вариант)

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))) 

Answer 2

Я предлагаю вам использовать gtable: вы можете извлечь легенды и y.label из первого «фиктивного» участка, затем участка каждого графика в пределах сот и с теми же размерами (сняв обе легенды и y.label из всех них, включая 1-й и последний), чтобы затем добавить 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()