4

I used the solution proposed here to color the strips of facets created with facet_wrap based on a variable supplied with the data frame. I need to add the legend for the strip colors (size), which is plotted in the dummy. Any idea of how I can grab it from g2$layout, or any other way?

library(gtable)
library(grid)

d <- data.frame(fruit = rep(c("apple", "orange", "plum", "banana", "pear", "grape")), 
            farm = rep(c(0,1,3,6,9,12), each=6), 
            weight = rnorm(36, 10000, 2500), 
            size=rep(c("small", "large")))

p1 = ggplot(data = d, aes(x = farm, y = weight)) + 
  geom_jitter(position = position_jitter(width = 0.3), 
          aes(color = factor(farm)), size = 2.5, alpha = 1) + 
  facet_wrap(~fruit)

dummy <- ggplot(data = d, aes(x = farm, y = weight))+ facet_wrap(~fruit) + 
  geom_rect(aes(fill=size), xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
  theme_minimal()

g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(dummy)

gtable_select <- function (x, ...) 
{
  matches <- c(...)
  x$layout <- x$layout[matches, , drop = FALSE]
  x$grobs <- x$grobs[matches]
  x
}

panels <- grepl(pattern="panel", g2$layout$name)
strips <- grepl(pattern="strip-t", g2$layout$name)
g2$layout$t[panels] <- g2$layout$t[panels] - 1
g2$layout$b[panels] <- g2$layout$b[panels] - 1

new_strips <- gtable_select(g2, panels | strips)
grid.newpage()
grid.draw(new_strips)

gtable_stack <- function(g1, g2){
  g1$grobs <- c(g1$grobs, g2$grobs)
  g1$layout <- transform(g1$layout, z= z-max(z), name="g2")
  g1$layout <- rbind(g1$layout, g2$layout)
  g1
}

new_plot <- gtable_stack(g1, new_strips)
grid.newpage()
grid.draw(new_plot)
Community
  • 1
  • 1
Jei
  • 43
  • 10

1 Answers1

2

Borrowing the following function from this answer, you can first extract the legend from your dummy plot.

# Extract only the legend from "dummy" plot
g_legend <- function(dummy){ 
  tmp <- ggplot_gtable(ggplot_build(dummy)) 
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") 
 legend <- tmp$grobs[[leg]] 
return(legend)} 
# Assign the legend to a separate object
facet.legend <- g_legend(dummy)

You can then use grid.arrange() from package gridExtra...

library(gridExtra)
jpeg("plot-with-facet-legend.jpg", width = 8, height = 6, units = "in", res = 300)
print(grid.arrange(new_plot, facet.legend, nrow = 2, widths = c(7, 1), heights = c(6, 0.01)))
dev.off()

... to produce the following plot:

plot with additional legend for colored facet headers

Alternatively: A more compact solution that grabs the legend straight from your g2 object, before executing the same jpeg(...), print(grid.arrange(...)) code:

facet.legend <- g2$grobs[[which(sapply(g2$grobs, function(x) x$name) %in% "guide-box")]]

Of course, you could play around with the widths and heights arguments to produce a more tidy plot, and there might exist another solution that is a little less hackneyed than mine, but hopefully this is at least roughly what you seek.

Community
  • 1
  • 1
sc_evans
  • 2,742
  • 1
  • 16
  • 15
  • 1
    That works like a charm, thank you! Changed `grid.arrange` to `ggdraw() + draw_plot(new_plot, 0, 0, 1, 1) + draw_plot(facet.legend, 0.63, 0.05, .3, .3)` to put the `facet.legend` on top of the `new_plot`, taking advantage of an unusable space of the plot, just to save space. Used `library(cowplot)` for that. – Jei Feb 10 '17 at 23:48