使用 grid_arrange_shared_legend 或 grid.arrange 时使用共享图例控制绘图宽度

Question

我有两个共享相同图例的情节。我想将它们与一个图例并排展示，但我希望左边的情节比右边的情节窄。

如果我使用 grid_arrange_shared_legend，我无法控制单独的绘图宽度：

library(ggplot2)
library(gridExtra)
library(grid)

cbPalette <- c("#d52b1e", "#176ca4", "#f7761b", "#734e9e", "#176ca4", "#f7761b", "#734e9e")

plotMeanShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotIndShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotMeanShapesLegend = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) 


grid_arrange_shared_legend <- function(..., ncol = length(list(...)), nrow = 1, position = c("bottom", "right")) {

  plots <- list(...)
  position <- match.arg(position)
  g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lheight <- sum(legend$height)
  lwidth <- sum(legend$width)
  gl <- lapply(plots, function(x) x + theme(legend.position="none"))
  gl <- c(gl, ncol = ncol, nrow = nrow)

  combined <- switch(position,
                     "bottom" = arrangeGrob(do.call(arrangeGrob, gl),
                                            legend,
                                            ncol = 1,
                                            heights = unit.c(unit(1, "npc") - lheight, lheight)),
                     "right" = arrangeGrob(do.call(arrangeGrob, gl),
                                           legend,
                                           ncol = 2,
                                           widths = unit.c(unit(1, "npc") - lwidth, lwidth)))

  grid.newpage()
  grid.draw(combined)

  # return gtable invisibly
  invisible(combined)

}

ppi <- 600
pageWidth <- 5.75
pageHeight <- 3.5

png("shapesArranged1.png", width = pageWidth, height = pageHeight, units = 'in', res = ppi)
grid_arrange_shared_legend(plotMeanShapes, plotIndShapes, ncol = 2, nrow = 1, position = "right")
dev.off()

我曾尝试在arrangeGrob 中使用layout_matrix 来控制单独的绘图宽度，但它不起作用：

library(ggplot2)
library(gridExtra)
library(grid)

cbPalette <- c("#d52b1e", "#176ca4", "#f7761b", "#734e9e", "#176ca4", "#f7761b", "#734e9e")

plotMeanShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotIndShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotMeanShapesLegend = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) 

grid_arrange_shared_legend <- function(..., ncol = length(list(...)), nrow = 1, position = c("bottom", "right")) {

  plots <- list(...)
  position <- match.arg(position)
  g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lheight <- sum(legend$height)
  lwidth <- sum(legend$width)
  lay <- rbind(c(1,1,2,2,2,2))
  gl <- lapply(plots, function(x) x + theme(legend.position="none"))
  gl <- c(gl, ncol = ncol, nrow = nrow)

  combined <- switch(position,
                     "bottom" = arrangeGrob(do.call(arrangeGrob, gl, layout_matrix = lay),
                                            legend,
                                            ncol = 1,
                                            heights = unit.c(unit(1, "npc") - lheight, lheight)),
                     "right" = arrangeGrob(do.call(arrangeGrob, gl, layout_matrix = lay),
                                           legend,
                                           ncol = 2,
                                           widths = unit.c(unit(1, "npc") - lwidth, lwidth)))

  grid.newpage()
  grid.draw(combined)

  # return gtable invisibly
  invisible(combined)

}

ppi <- 600
pageWidth <- 5.75
pageHeight <- 3.5

png("shapesArranged1.png", width = pageWidth, height = pageHeight, units = 'in', res = ppi)
grid_arrange_shared_legend(plotMeanShapes, plotIndShapes, ncol = 2, nrow = 1, position = "right")
dev.off()

我尝试使用 grid.arrange 代替，但是当我将图形保存为 png 时，图例会变得很大：

cbPalette <- c("#d52b1e", "#176ca4", "#f7761b", "#734e9e", "#176ca4", "#f7761b", "#734e9e")

plotMeanShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotIndShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotMeanShapesLegend = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) 

library(gridExtra)

g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  legend
}

legend <- g_legend(plotMeanShapesLegend)

ppi <- 600
pageWidth <- 5.75
pageHeight <- 3.5

lay <- rbind(c(1,1,2,2,2,3))
grid.arrange(plotMeanShapes, plotIndShapes, legend, layout_matrix = lay)

png("shapesArranged2.png", width = pageWidth, height = pageHeight, units = 'in', res = ppi)
grid.arrange(plotMeanShapes, plotIndShapes, legend, layout_matrix = lay)    
dev.off()

我想要 grid.arrange 的宽度控制与合理的 grid_arrange_shared_legend 的图例大小/位置。

Answer 1

cowplot 很擅长这个：

library(cowplot)
theme_set(theme_grey())

plot_grid(
  plotMeanShapes, 
  plotIndShapes, 
  get_legend(plotMeanShapes + theme(legend.position="right")),
  nrow = 1, rel_widths = c(3, 2, 1)
)

只需更改 rel_widths 即可获得所需的尺寸。如果需要，您也可以很好地对齐图。

Answer 2

添加宽度和高度参数更有意义，

library(ggplot2)
library(gridExtra)
library(grid)

cbPalette <- c("#d52b1e", "#176ca4", "#f7761b", "#734e9e", "#176ca4", "#f7761b", "#734e9e")

plotMeanShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotIndShapes = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) + 
  theme(legend.position="none")

plotMeanShapesLegend = ggplot(diamonds, aes(clarity, fill = color)) + 
  geom_bar() + 
  facet_wrap(~cut, nrow = 1) +
  scale_fill_manual(values=cbPalette, name="condition", labels = c("really really long text", "2", "3", "4", "5", "6", "7")) 


grid_arrange_shared_legend <- function(..., 
                                       ncol = length(list(...)), 
                                       nrow = 1, 
                                       widths = rep(1, ncol),
                                       heights = rep(1, nrow),
                                       position = c("bottom", "right")) {

  plots <- list(...)
  position <- match.arg(position)
  g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lheight <- sum(legend$height)
  lwidth <- sum(legend$width)
  gl <- lapply(plots, function(x) x + theme(legend.position="none"))
  gl <- c(gl, list(widths = widths, heights = heights))

  combined <- switch(position,
                     "bottom" = arrangeGrob(do.call(arrangeGrob, gl),
                                            legend,
                                            ncol = 1,
                                            heights = unit.c(unit(1, "npc") - lheight, lheight)),
                     "right" = arrangeGrob(do.call(arrangeGrob, gl),
                                           legend,
                                           ncol = 2,
                                           widths = unit.c(unit(1, "npc") - lwidth, lwidth)))

  grid.newpage()
  grid.draw(combined)

  # return gtable invisibly
  invisible(combined)

}

grid_arrange_shared_legend(plotMeanShapes, plotIndShapes, 
                           widths=c(2,1), nrow = 1, position = "right")