Kontrollplotbreite mit geteilter Legende bei Verwendung von grid_arrange_shared_legend oder grid.arrange

Question

Ich habe zwei Diagramme, die dieselbe Legende haben. Ich möchte sie Seite an Seite mit einer Legende präsentieren, aber ich möchte, dass die linke Handlung enger ist als die rechte.

Wenn ich grid_arrange_shared_legend verwenden, kann ich nicht die individuelle Handlung steuert Breite:

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

Ich habe versucht, einzelne Handlung zu steuern Breite mit layout_matrix in arrangeGrob, aber es funktioniert nicht Arbeit:

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

ich habe mit grid.arrange versucht stattdessen, aber wenn ich die Figur als png speichern, kommt die Legende aus riesig:

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

würde ich die Breite Kontrolle grid.arrange mit der fühlbaren Legende Größe/Platzierung von grid_arrange_shared_legend mag.

Answer 1

cowplot ist wirklich gut auf diese:

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

einfach die rel_widths variieren die Größen, die Sie benötigen. Sie können die Plots bei Bedarf auch gut ausrichten.

Answer 2

es mehr Sinn macht, Breiten und Höhen Argumente hinzuzufügen,

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