ggplot2: डेटा सेट में परिवर्तनीय पर आधारित facet_wrap स्ट्रिप रंग

Question

क्या डेटा फ्रेम के साथ प्रदान किए गए चर के आधार पर facet_wrap के साथ बनाए गए पहलुओं के स्ट्रिप्स को भरने का कोई तरीका है?

उदाहरण डेटा:

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

वहाँ पैरामीटर element_rect में fill को MYdata में चर size में मान प्रदान करने के लिए एक रास्ता है?

असल में, सभी स्ट्रिप्स के लिए 1 रंग की बजाय मैं छोटे फलों (सेब, बेर, नाशपाती) के स्ट्रिप पृष्ठभूमि रंग को हरे रंग के होने और लाल फल (नारंगी, केले, अंगूर) के पृष्ठभूमि रंग लाल होने के लिए पसंद करूंगा ।

Answer 1

मुझे यह जानना अच्छा लगेगा कि यह कैसे करना है, यह एक अच्छा विचार है। एक विचार यह है कि प्रत्येक चार्ट को अलग-अलग रंग के साथ स्वतंत्र रूप से उत्पन्न करना है और उसके बाद मल्टीप्लॉट या व्यूपोर्ट्स जैसे कुछ तरफ दिखाने के लिए उपयोग करना है - इसके लिए थोड़ा और काम की आवश्यकता होगी।

आप कथा है, जो आप इस दृष्टिकोण के लिए की आवश्यकता होगी निकालने के लिए चाहते हैं - यहाँ हैडली से कुछ कोड है कि मैं एक समय पहले

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

देखते हैं कि कैसे यह चार्ट पी से निकाला जाता है पाया है, और तो मैं इसे साजिश के बाहर ले कथा < - g_legend (पी) < lwidth - योग (कथा $ चौड़ाई) #if आप इस पी < के आधार पर व्यूपोर्ट परिभाषित करना चाहते हैं - पी + थीम (legend.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) 

गुड लक

Answer 2

काम का एक छोटा सा के साथ, आप एक डमी gtable सही grobs है कि के साथ अपने भूखंड को जोड़ सकते हैं,

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)