Вопрос по r, ggplot2, facet – Несколько цветов на фасете фон STRIP

7

Я хотел бы изменить цвета фона фасета в зависимости от группы. Я не уверен, возможно ли это вообще. В частности, я используюfacet_grid (неfacet_wrap) с несколькими слоями.

## Sample data
dat <- mtcars
## Add in some colors based on the data
dat$facet_fill_color <- c("red", "green", "blue", "yellow", "orange")[dat$gear]

## Create main plot
library(ggplot2)
P <- ggplot(dat, aes(x=cyl, y=wt)) + geom_point(aes(fill=hp)) + facet_grid(gear+carb ~ .)

## I can easily cahnge the background using: 
P + theme(strip.background = element_rect(fill="red"))

Тем не менее, я хотел бы изменить цвет по-разному для разных групп. В идеале что-то вроде следующего (что конечно не работает)

P + theme(strip.background = element_rect(fill=dat$facet_fill_color))
P + theme(strip.background = element_rect(aes(fill=facet_fill_color)))

Может ли быть более одного цвета для фоновых изображений?

(связанный, но не фактический ответ на выше:ggplot2: цвет полосы facet_wrap на основе переменной в наборе данных)

вы можете найтиэтот ответ и связанный ответ полезен. Simon O'Hanlon

Ваш Ответ

3   ответа
3

Альтернативная стратегия поиска и замены, основанная на решении @ SimonO'Hanlon,

strips <- grep(pattern="strip-right", Pg$layout$name)

refill <- function(strip, colour){
  strip[["children"]][[1]][["gp"]][["fill"]] <- colour
  strip
}
cols <- rep_len(rep.int(c("blue", "green", "red"), c(4,3,4)), length(strips))
Pg$grobs[strips] <- mapply(refill, 
                           strip = Pg$grobs[strips], 
                           colour = cols,
                           SIMPLIFY = FALSE)

grid.newpage()
grid.draw(Pg)
это вариант той же идеи, поэтому я подумал, что вы можете вставить ее в свой ответ. Как вы предпочитаете, до вас. baptiste
Я думаю, что это достаточно отличается и полезно иметь свой слот для ответов. Мне нравятся оба из них, и я буду их использовать (когда мне нужно сделать что-то похожее на моё решение - но обычно, чтобы установить ширину границы вокругpch=21 points - ширина контура не устанавливается в ggplot2 и масштабируется с размером точек, который мне не нравится). Simon O'Hanlon
baptiste - @ обрабатывает работу только в комментариях и чате! Тебе повезло, я проверил, чтобы увидеть это. +1. Все еще лучше, чем у меня. Simon O'Hanlon
3

Это похоже на ужасную хакерскую вещь (до такой степени, что я почти смущен, чтобы опубликовать это какответ), но это возможно ...

require(ggplot2);require(grid)

# Facet strip colours
cols <- rep( c("red", "green", "blue", "yellow", "orange")[rep( c(4,3,5),times=c(4,3,4))] , 2 )

# Make a grob object
Pg <- ggplotGrob(P)

# To keep track of strip.background grobs
idx <- 0 

# Find each strip.background and alter its backround colour...
for( g in 1:length(Pg$grobs) ){
    if( grepl( "strip.absoluteGrob" , Pg$grobs[[g]]$name ) ){
        idx <- idx + 1
        sb <- which( grepl( "strip\\.background" , names( Pg$grobs[[g]]$children ) ) )
        Pg$grobs[[g]]$children[[sb]][]$gp$fill <- cols[idx]

    }
}

# Plot
grid.newpage()
grid.draw(Pg)

11

Для чего это стоит, довольно просто адаптировать этот предыдущийgtable hack.

## Sample data
require(ggplot2)
dat <- mtcars
## Add in some colors based on the data
dat$facet_fill_color <- c("red", "green", "blue", "yellow", "orange")[dat$gear]

## Create main plot
p <- ggplot(dat, aes(x=cyl, y=wt)) + 
  geom_point(aes(fill=hp)) + facet_grid(gear+carb ~ .) +
  theme(strip.background=element_blank())

dummy <- p
dummy$layers <- NULL
dummy <- dummy + geom_rect(data=dat, xmin=-Inf, ymin=-Inf, xmax=Inf, ymax=Inf,
                           aes(fill = facet_fill_color))

library(gtable)

g1 <- ggplotGrob(p)
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-right", g2$layout$name)
g2$grobs[strips] <- replicate(sum(strips), nullGrob(), simplify = FALSE)
g2$layout$l[panels] <- g2$layout$l[panels] + 1
g2$layout$r[panels] <- g2$layout$r[panels] + 2

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 <- 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)
Ой.ТАК намного приятнее +10. Simon O'Hanlon

Похожие вопросы