68

データ フレームで提供される変数に基づいて、facet_wrap で作成されたファセットのストリップを埋める方法はありますか?

サンプルデータ:

MYdata <- 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 = MYdata, 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)

ストリップの背景色を変更する方法を知っています（たとえば、オレンジ色に）：

p1 + theme(strip.background = element_rect(fill="orange"))

facet_wrap とオレンジ色の帯の色

size変数内の値をMYdataパラメータfill内に渡す方法はありますelement_rectか?

基本的に、すべてのストリップを 1 色にするのではなく、小さな果物 (リンゴ、プラム、ナシ) のストリップの背景色を緑に、大きな果物 (オレンジ、バナナ、ブドウ) の背景色を赤にしたいと思います。

4

4 に答える 4

70

ちょっとした作業で、プロットを適切なグロブを持つダミーの gtable と組み合わせることができます。

ここに画像の説明を入力

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

library(gtable)

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
}
## ideally you'd remove the old strips, for now they're just covered
new_plot <- gtable_stack(g1, new_strips)
grid.newpage()
grid.draw(new_plot)
于 2014-02-05T22:25:03.933 に答える