有没有办法根据数据框提供的变量填充使用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种颜色,我希望小水果(苹果,李子,梨)的条带背景颜色为绿色,大果实(橙色,香蕉,葡萄)的背景颜色为红色。
答案 0 :(得分:59)
通过一些工作,您可以将您的情节与具有正确凹凸的虚拟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)
答案 1 :(得分:1)
您可以找到有关此问题here的更新答案。
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)
答案 2 :(得分:0)
我很想知道如何做到这一点,这是一个好主意。一个想法是使用不同的颜色独立生成每个图表,然后使用多色图或视口等并排显示 - 这将需要更多的工作。
如果你想提取这个方法所需要的图例 - 这里有一些来自哈德利的代码,我发现了一段时间
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中提取它,然后我把它从图中取出 传奇&lt; - g_legend(p) lwidth&lt; - sum(图例$ width)#如果要基于此定义视口 p&lt; - p + theme(legend.position =“none”)
然后你最终画出它
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)
祝你好运
答案 3 :(得分:0)