Haz una leyenda rectangular, con filas y columnas etiquetadas, en grilla

Tengo un ggplot donde estoy mapeando factores para llenar y alfa, así:

set.seed(47) the_data <- data.frame(value = rpois(6, lambda=20), cat1 = rep(c("A", "B"), each = 3), cat2 = rep(c("X", "Y", "Z"), 2)) ggplot(the_data, aes(y = value, x = cat2, alpha = cat1, fill = cat2)) + geom_bar(stat = "identity", position = "dodge") + scale_alpha_discrete(range = c(0.5, 1)) + theme_bw() 

enter image description here

Las personas para las que lo estoy produciendo no encuentran la leyenda para alfa muy clara. Creo que una buena alternativa sería algo como esto (que pirateé en gráficos base):

enter image description here

Sé que no puedo generar una leyenda como esa con comandos de ggplot de alto nivel, pero ¿puedo hacerlo en la grid y ponerla en la parte superior de mi ttwig?

Aquí hay un posible punto de partida. Creo dos gráficos diferentes que tienen las leyendas apropiadas: un “shiny” y un “pálido”. Extrae las leyendas de los objetos de la ttwig. A continuación, utilice grid viewport grid , una para el gráfico y otra para cada leyenda, para unir las piezas.

 library(grid) library(gtable) # create plot with legend with alpha = 1 g1 <- ggplot(the_data, aes(y = value, x = cat2, alpha = cat1, fill = cat2)) + geom_bar(stat = "identity", position = "dodge") + scale_alpha_discrete(range = c(0.5, 1)) + theme_bw() + guides(fill = guide_legend(title = "A", title.hjust = 0.4), alpha = FALSE) + theme_bw() + theme(legend.text = element_blank()) g1 # grab legend legend_g1 <- gtable_filter(ggplot_gtable(ggplot_build(g1)), "guide-box") # create plot with 'pale' legend g2 <- ggplot(the_data, aes(y = value, x = cat2, alpha = cat1, fill = cat2)) + geom_bar(stat = "identity", position = "dodge") + scale_alpha_discrete(range = c(0.5, 1)) + guides(fill = guide_legend(override.aes = list(alpha = 0.5), title = "B", title.hjust = 0.3), alpha = FALSE) + theme_bw() g2 # grab legend legend_g2 <- gtable_filter(ggplot_gtable(ggplot_build(g2)), "guide-box") # arrange plot and legends # legends to the right # define plotting regions (viewports) vp_plot <- viewport(x = 0.4, y = 0.5, width = 0.8, height = 1) vp_legend_g1 <- viewport(x = 0.85, y = 0.5, width = 0.4, height = 0.4) vp_legend_g2 <- viewport(x = 0.90, y = 0.5, width = 0.4, height = 0.4) # clear current device grid.newpage() # add objects to the viewports # plot without legend print(g1 + theme(legend.position = "none"), vp = vp_plot) upViewport(0) pushViewport(vp_legend_g1) grid.draw(legend_g1) upViewport(0) pushViewport(vp_legend_g2) grid.draw(legend_g2) 

enter image description here

 # legends on top vp_plot <- viewport(x = 0.5, y = 0.4, width = 1, height = 0.85) vp_legend_g1 <- viewport(x = 0.5, y = 0.9, width = 0.4, height = 0.4) vp_legend_g2 <- viewport(x = 0.55, y = 0.9, width = 0.4, height = 0.4) grid.newpage() print(g1 + theme(legend.position = "none"), vp = vp_plot) upViewport(0) pushViewport(vp_legend_g1) grid.draw(legend_g1) upViewport(0) pushViewport(vp_legend_g2) grid.draw(legend_g2) 

enter image description here

@Henrik

Esto podría ser un poco más fácil,

 g1 <- ggplotGrob(p1) g2 <- ggplotGrob(p2) leg1 <- gtable_filter(g1, "guide-box") leg2 <- gtable_filter(g2, "guide-box") leg <- gtable:::cbind_gtable(leg1[["grobs"]][[1]], leg2[["grobs"]][[1]], "first") g1$grobs[g1$layout$name == "guide-box"][[1]] <- leg g1$widths[max(subset(g1$layout, name == "guide-box")[["r"]])] <- list(leg1$width + leg2$width) grid.newpage() grid.draw(g1)