ggplot2: цвет полосы facet_wrap на основе переменной в наборе данных

Есть ли способ заполнить полосы фасетов, созданные с помощью 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"))

facet_wrap и цвет оранжевой полосы

Есть ли способ передать значения переменной size в MYdata параметру fill в element_rect?

По сути, вместо одного цвета для всех полосок я хотел бы, чтобы цвет фона полосы мелких фруктов (яблоко, слива, груша) был зеленым, а цвет фона крупных фруктов (апельсин, банан, виноград) был красным.


person Dalmuti71    schedule 18.10.2013    source источник
comment
Это не простой способ сделать это, уже был задан ранее хотя на другом сайте.   -  person nograpes    schedule 18.10.2013
comment
Спасибо, нет. Я посмотрел, но не нашел, где об этом спрашивали раньше.   -  person Dalmuti71    schedule 22.10.2013
comment
Если вы заставите этот код работать, вы должны опубликовать его в качестве ответа.   -  person nograpes    schedule 22.10.2013
comment
Я хотел бы знать, как это сделать, это отличная идея   -  person user1617979    schedule 05.02.2014
comment
+1 за эту функцию. Было бы неплохо иметь возможность указывать в теме.   -  person Eric Green    schedule 09.10.2014


Ответы (4)


Немного поработав, вы можете объединить свой участок с фиктивной таблицей с нужными гробами,

введите описание изображения здесь

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)
person baptiste    schedule 05.02.2014
comment
Это просто потрясло мой мир! Пытался сделать это целую вечность! - person orville jackson; 19.08.2014
comment
Спасибо за это! Есть идеи, как включить легенду для цветов полос? - person jayelm; 04.05.2016
comment
Очень полезно, спасибо! Это входит в статью, которую я пишу сейчас (и я цитирую этот ответ в коде, который я в конечном итоге заархивирую). - person lukeholman; 30.05.2016
comment
@duckertito Вы могли отредактировать сообщение. Я сделал это сейчас. В текущей версии ggplot2_2.2.1 вам нужно использовать grepl для strip-t вместо strip_t. Также изменил это в моем редактировании. Кстати, спасибо за хорошее решение! - person andschar; 21.02.2017
comment
Да, у меня тоже работает (с изменением @andrasz). Хотел бы я поставить легенду о цвете полосы. Есть идеи, как это сделать? - person mic; 10.04.2018
comment
Это именно то, что мне нужно, спасибо. Но метки фасетов не отображаются, когда я запускаю этот код. - person user1757654; 30.05.2018
comment
У меня также возникают проблемы с тем, что метки фасетов не отображаются. Решение еще не найдено? - person philiporlando; 03.12.2018
comment
вроде поздний ответ ... Я только что столкнулся с той же проблемой и решил ее, добавив эту строку stript <- grepl(pattern="strip-t", g2$layout$name), а затем заменив new_strips <- gtable_select(g2, panels | strips) на new_strips <- gtable_select(g2, panels | strips | stript) - person SamPer; 22.09.2020
comment
Когда я пытаюсь это сделать, я получаю сообщение об ошибке: Ошибка в grid.Call.graphics (C_setviewport, vp, TRUE): invalid 'layout.pos.col', но я не могу понять, как это исправить. Какие-либо предложения? - person clions226; 08.07.2021

Вы можете найти обновленный ответ на этот вопрос здесь.

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)

введите здесь описание изображения

person filups21    schedule 06.02.2020

Я хотел бы знать, как это сделать, это отличная идея. Одна из идей состоит в том, чтобы генерировать каждую диаграмму независимо с другим цветом, как и вы, а затем использовать что-то вроде нескольких графиков или видовых экранов, чтобы отображать их рядом - это потребует немного больше работы.

если вы хотите извлечь легенду, которая вам понадобится для этого подхода - вот код от Хэдли, который я нашел некоторое время назад

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, а затем я взял его из легенды графика ‹- g_legend (p) lwidth‹ - sum (legend $ width) # если вы хотите определить область просмотра на основе этого p ‹- p + тема (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)

Удачи

person user1617979    schedule 05.02.2014

Это не напрямую для другой окраски ваших граней, но здесь у вас есть другое (очень быстрое и простое) решение, основанное на фасете двумя переменными (size ~ fruit) вместо одной (~ fruit):

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(size ~ fruit)

введите здесь описание изображения

person jgarces    schedule 04.03.2020