parcelle de contrôle de largeur avec la légende partagée lors de l'utilisation grid_arrange_shared_legend ou grid.arrange

Question

J'ai deux parcelles qui partagent la même légende. Je veux les présenter côte à côte avec une légende, mais je voudrais que le tracé de gauche à être plus étroit que le graphique de droite.

Si je grid_arrange_shared_legend, je ne peux pas contrôler la parcelle individuelle largeurs:

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

J'ai essayé de contrôler parcelle individuelle en utilisant des largeurs layout_matrix en arrangeGrob, mais il n'a pas travail:

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

J'ai essayé d'utiliser à la place grid.arrange, mais quand je sauve la figure comme .png, la légende sort énorme:

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

Je voudrais le contrôle de la largeur grid.arrange avec le sensible taille de la légende/mise en place de grid_arrange_shared_legend.

Answer 1

cowplot est vraiment bon à ceci:

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

Juste varier la rel_widths pour obtenir les tailles dont vous avez besoin. Vous pouvez aligner les parcelles bien ainsi, le cas échéant.

Answer 2

il est plus logique d'ajouter des largeurs et hauteurs arguments,

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