ストリップカラーグループの凡例を含める方法

Question

提案されたソリューションhereを使用して、データフレームに付属する変数に基づいてfacet_wrapで作成されたファセットのストリップをカラーリングしました。 ストリップカラー（size）の凡例を追加する必要があります。これはdummyにプロットされています。 g2$layout、または他の方法から私がそれをどのようにつかむことができるかについての任意のアイデア？

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

this answerから次の関数を借用すると、まずダミープロットから凡例を抽出できます。また

：

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

その後、次のプロットを生成するために...パッケージ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() 

を... grid.arrange()を使用することができ、よりコンパクトなソリューションをその同じを実行する前に、 g2オブジェクトからまっすぐ凡例を取得します3210、 print(grid.arrange(...))コード：もちろん

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

は、あなたがもっときちんとプロットを生成するためにwidthsとheights引数で遊んことができ、そして私より少し陳腐である別の解決策が存在するかもしれないが、うまくいけば、この少なくともおおよそあなたが求めるものです。