web-dev-qa-db-fra.com

ggplot2: couleur de bande facet_wrap basée sur la variable dans le jeu de données

Existe-t-il un moyen de remplir les bandes de facettes créées avec facet_wrap en fonction d'une variable fournie avec le bloc de données?

Exemple de données:

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

Exemple de tracé:

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)

Je sais comment changer la couleur de fond des bandes (par exemple en orange):

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

facet_wrap and orange strip color

Existe-t-il un moyen de transférer les valeurs de la variable size dans MYdata au paramètre fill dans element_rect?

Fondamentalement, au lieu d'une couleur pour toutes les bandes, j'aimerais que la couleur de fond des petits fruits (pomme, prune, poire) soit verte et que la couleur de fond des gros fruits (orange, banane, raisin) soit rouge.

rggplot2facet-wrap
46
Dalmuti71

Avec un peu de travail, vous pouvez combiner votre intrigue avec un gtable factice qui a les bonnes grobs,

enter image description here

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)
58
baptiste

J'aimerais savoir comment faire cela, c'est une excellente idée. Une idée est de générer chaque graphique indépendamment avec une couleur différente, puis d’utiliser quelque chose comme un multiplot ou une fenêtre pour l’afficher côte à côte - cela demandera un peu plus de travail.

si vous voulez extraire la légende dont vous aurez besoin pour cette approche - voici du code de Hadley que j'ai trouvé il y a quelque temps

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

voyez comment il est extrait du tableau p, puis je l'ai extrait de l'intrigue légende <- g_legend (p) lwidth <- sum (legend $ width) #si vous voulez définir la fenêtre d’affichage sur cette base p <- p + thème (legend.position = "none")

alors vous le dessinez finalement 

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)

Bonne chance

0
user1617979