ggplot2:facet_wrap基于数据集中变量的条带颜色

Question

有没有办法根据随数据框提供的变量填充使用facet_wrap创建的facet条？

示例数据:

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

有没有办法转嫁值的变量size中MYdata的参数fill的element_rect？

基本上,对于所有条带而不是1种颜色,我希望小水果(苹果,李子,梨)的条带背景颜色为绿色,大果实(橙色,香蕉,葡萄)的背景颜色为红色.

Answer 1

通过一些工作,您可以将您的情节与具有正确凹凸的虚拟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)

Answer 2

如果您想对条带背景进行不同的填充，可以使用 ggh4x 中的facets 来设置更复杂的条带strip_themed()。使用 gtables 没有麻烦，并且您的绘图仍然是 ggplot，因此您可以随后添加常用的图层/比例/主题选项等。

library(ggh4x)
#> Loading required package: ggplot2

# Only colour strips in x-direction
strip <- strip_themed(background_x = elem_list_rect(fill = rainbow(7)))

# Wrap variant
ggplot(mpg, aes(displ, hwy)) +
  geom_point() +
  facet_wrap2(~ class, strip = strip)

它也适用于网格布局，但如果您想为垂直条带着色，您也需要设置background_y参数strip_themed()。

ggplot(mpg, aes(displ, hwy)) +
  geom_point() +
  facet_grid2(year ~ cyl, strip = strip)

^{由reprex 包于 2023 年 1 月 4 日创建(v2.0.1)}

免责声明：我是 ggh4x 的作者

Answer 3

您可以在此处找到此问题的更新答案。

g <- ggplot_gtable(ggplot_build(p))
stripr <- which(grepl('strip-r', g$layout$name))
fills <- c("red","green","blue","yellow")
k <- 1
for (i in stripr) {
  j <- which(grepl('rect', g$grobs[[i]]$grobs[[1]]$childrenOrder))
  g$grobs[[i]]$grobs[[1]]$children[[j]]$gp$fill <- fills[k]
  k <- k+1
}
grid::grid.draw(g)

Answer 4

我很想知道如何做到这一点，这是个好主意。一个想法是像您一样使用不同的颜色独立生成每个图表，然后使用多图或视口之类的东西并排显示 - 这将需要更多的工作。

如果你想提取图例，你将需要这种方法 - 这是我不久前发现的来自 Hadley 的一些代码

g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)}

看看它是如何从图表 p 中提取出来的，然后我把它从绘图中取出来 legend <- g_legend(p) lwidth <- sum(legend$width) #if you Want to Define the viewport based on this p <- p + 主题（图例.position=“无”）

然后你最终画出它

grid.newpage()
vp <- viewport(width = 1, height = 1)
#print(p, vp = vp)

submain <- viewport(width = 0.9, height = 0.9, x = 0.5, y = 1,just=c("center","top"))
print(p, vp = submain)
sublegend <- viewport(width = 0.5, height = 0.2, x = 0.5, y = 0.0,just=c("center","bottom"))
print(arrangeGrob(legend), vp = sublegend)

祝你好运