颜色剥离面向包装ggplot中的设置

时间:2017-05-19 23:27:40

标签: ggplot2 facet-wrap

到一个3岁的帖子 ggplot2: facet_wrap strip color based on variable in data set

巴普蒂斯特给出了以下解决方案:

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)

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

(我刚刚更新了&#34; strip-t&#34;模式并打开了旧帖子中建议的网格库)

我重新发布这个因为它是一个古老的东西,我想自己用它来进行演示。 我是ggplot的初学者,这也可以帮助我完成各种脚本。

以下是我的问题: - 如何选择颜色而不是给出相同的蓝色和红色?在我的剧本中,我有3种颜色可供设置,我希望它可以不那么激进。有可能吗? - 另一个问题是,是否有可能将其整合到图例中,即知道这些颜色是指什么?

非常感谢

1 个答案:

答案 0 :(得分:1)

您可以使用虚拟图中的填充比例更改条带颜色。结合传说有点棘手,但这是一个起点。

enter image description here

library(ggplot2)
library(gtable)
library(gridExtra)
library(grid)

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
}

gtable_select <- function (x, ...) 
{
  matches <- c(...)
  x$layout <- x$layout[matches, , drop = FALSE]
  x$grobs <- x$grobs[matches]
  x
}


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() + scale_fill_brewer(palette = "Pastel2") 


g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(dummy)

# extract legends
leg <- g1$grobs[[grep("guide-box", g1$layout$name)]]
dummy_leg <- g2$grobs[[grep("guide-box", g2$layout$name)]]
combined_leg <- rbind.gtable(leg, dummy_leg)
g1$grobs[[grep("guide-box", g1$layout$name)]] <- combined_leg

# move dummy panels one cell up
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)

# stack new strips on top of gtable
# 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)