web-dev-qa-db-de.com

ggplot2: Farbe des facet_wrap-Streifens basierend auf der Variablen im Datensatz

Gibt es eine Möglichkeit, die mit facet_wrap erstellten Facettenstreifen basierend auf einer mit dem Datenrahmen gelieferten Variablen zu füllen?

Beispieldaten:

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

Beispiel Handlung:

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)

Ich kann die Hintergrundfarbe der Streifen ändern (z. B. in orange):

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

facet_wrap and orange strip color

Gibt es eine Möglichkeit, die Werte in der Variablen size in MYdata an den Parameter fill in element_rect weiterzuleiten?

Grundsätzlich möchte ich, dass anstelle von 1 Farbe für alle Streifen die Streifenhintergrundfarbe kleiner Früchte (Apfel, Pflaume, Birne) grün und die Hintergrundfarbe großer Früchte (Orange, Banane, Traube) rot ist.

46
Dalmuti71

Mit ein bisschen Arbeit können Sie Ihren Plot mit einer Dummy-Tabelle mit den richtigen Grobs kombinieren.

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

Ich würde gerne wissen, wie das geht, es ist eine großartige Idee. Eine Idee ist, jedes Diagramm unabhängig voneinander mit einer anderen Farbe zu generieren und dann etwas wie Multiplot oder Ansichtsfenster zu verwenden, um es nebeneinander anzuzeigen. Dies erfordert etwas mehr Arbeit.

wenn Sie die Legende extrahieren möchten, die Sie für diesen Ansatz benötigen - hier ist ein Code von Hadley, den ich vor einiger Zeit gefunden habe

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

sehen Sie, wie es aus Diagramm p extrahiert wird, und dann habe ich es aus der Handlung genommen. Legende <- g_legend (p) lwidth <- sum (Legende $ width) #wenn Sie den Darstellungsbereich auf dieser Grundlage definieren möchten p <- p + theme (legend.position = "none")

dann zeichnest du es schließlich 

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)

Viel Glück

0
user1617979