Wie lege ich die Legende für Streifen Farbgruppen ein

Question

Ich habe die Lösung here verwendet, um die Streifen von Facetten zu färben, die mit facet_wrap erstellt wurden, basierend auf einer Variablen, die mit dem Datenrahmen geliefert wurde. Ich muss die Legende für die Streifenfarben hinzufügen (size), die in der dummy gezeichnet wird. Irgendeine Idee, wie ich es von g2$layout oder auf andere Weise greifen kann?

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) 

Answer 1

Borrowing die folgende Funktion von this answer, können Sie zunächst die Legende aus dem Dummy-Plot extrahieren.

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

Sie können dann grid.arrange() von Paket verwenden 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() 

... die folgende Handlung zu produzieren:

Alternativ: eine kompaktere Lösung, packt die Legende direkt von Ihrem g2 Objekt, bevor Sie dieselbeausführen, print(grid.arrange(...)) Code:

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

Natürlich könnte man mit den widths und heights Argumente spielen, um eine ordentliche Handlung zu erzeugen, und es könnte eine andere Lösung gibt, die etwas weniger abgedroschen als meine, aber hoffentlich diese ist zumindest grob, was du suchst.