Я пытаюсь создать цветовой градиент в аргументах заливки в strip.background() функции ggplot2() package.

Вот изображение того, что я хотел бы иметь:

И код, который я использую, чтобы попытаться получить это:

 # Charge random data
data('mtcars')

# Create fake variable in order to create title into coloured box
mtcars$tempvar <- "My title"

# Run the ggboxplot
ggboxplot(mtcars, x = "cyl", y = "qsec", 
          color = "cyl", 
          palette = c("#E7B800", "#FC4E07",  "#00AFBB"),
          ylab = "cyl", xlab = "qsec",
          legend = "none")   

 facet_grid(. ~ tempvar)  
  theme(strip.background = element_rect(fill="darkgreen"),
        strip.text = element_text(size=15, colour="white") )
  

Это дает:

Итак, я пытаюсь создать палитру из scale_color_manual() или из colorRampPalette(c("yellow", "green")) и вставить element_rect() , но это не сработало.

Я также пытаюсь загрузить изображение градиентного фона из Google Image и вставить его в нужное место с помощью annotation_custom(rasterGrob(image)) like в этом блоге, но это тоже не работает.

Буду признателен за любые советы по программированию этого надлежащим образом.

Технически? Это можно сделать. (Является ли это chartjunk или хорошей практикой — другой вопрос …)

 p <- ggplot(mtcars, aes(mpg, drat))   
  geom_point()   
  facet_grid(~"facet title") 

# basic demonstration
p  
  theme(strip.background = 
          element_gradient(fill1 = "black", fill2 = "white"))

# with different gradient direction amp; outline specifications
p  
  theme_minimal()  
  theme(strip.background = 
          element_gradient(fill1 = "brown", fill2 = "salmon",
                           direction = "vertical",
                           color = "white", size = 2,
                           linetype = "dotted"))

# with horizontal / vertical facets in different gradient directions
p   facet_grid("vertical title" ~ "horizontal facet title")  
  theme_classic()  
  theme(strip.background = element_gradient(fill1 = "green", fill2 = "yellow", size = 1),
        strip.background.y = element_gradient(direction = "vertical"))
  

1. Определение element_gradient в качестве альтернативы element_rect :

 element_gradient <- function(fill1 = NULL, fill2 = NULL, direction = NULL,
                             colour = NULL, size = NULL,
                             linetype = NULL, color = NULL, inherit.blank = FALSE) {
  if (!is.null(color))  colour <- color
  structure(
    list(fill1 = fill1, fill2 = fill2, direction = direction,
         colour = colour, size = size, linetype = linetype,
         inherit.blank = inherit.blank),
    class = c("element_gradient", "element")
  )
}

element_grob.element_gradient <- function(
  element, 
  fill1 = "white", fill2 = "red", direction = "horizontal", # default: white-red gradient
  x = 0.5, y = 0.5, width = 1, height = 1, colour = NULL, 
  size = NULL, linetype = NULL, ...) {

  # define gradient colours amp; direction
  if(!is.null(element$fill1)) fill1 <- element$fill1
  if(!is.null(element$fill2)) fill2 <- element$fill2
  if(!is.null(element$direction)) direction <- element$direction  
  image <- colorRampPalette(c(fill1, fill2))(2)  
  if(direction == "horizontal") {
    image <- matrix(image, nrow = 1)
  } else {
    image <- matrix(image, ncol = 1)
  }

  gp <- grid::gpar(lwd = ggplot2:::len0_null(size * .pt), col = colour, lty = linetype)
  element_gp <- grid::gpar(lwd = ggplot2:::len0_null(element$size * .pt), col = element$colour,
                     lty = element$linetype, fill = NA)  
  grid::grobTree(
    grid::rasterGrob(image, x, y, width, height, ...),
    grid::rectGrob(x, y, width, height, gp = utils::modifyList(element_gp, gp), ...))
}
  

2. Принудительно ggplot принять element_gradient вместо element_rect для strip.background / strip.background.x / strip.background.y :

 # make a copy of ggplot's global variables / settings, amp; modify its element_tree
ggplot_global.new <- ggplot2:::ggplot_global
ggplot_global.new$element_tree$gradient <- ggplot2:::el_def("element_gradient")
ggplot_global.new$element_tree$strip.background <- ggplot2:::el_def("element_gradient", "gradient")
ggplot_global.new$element_tree$strip.background.x <- ggplot2:::el_def("element_gradient", "strip.background")
ggplot_global.new$element_tree$strip.background.y <- ggplot2:::el_def("element_gradient", "strip.background")
  

3. Заставьте ggplot не жаловаться на это, вручную переопределив его проверки:

Примечание: Хотя обычно мне не нравится изменять внутренние функции пакета (даже если это на временной основе), в данном случае альтернативой было бы определение ряда промежуточных функций на основе существующих неэкспортированных функций в ggplot2 пакете и изменение каждой по очереди. Учитывая количество задействованных шагов / функций, я думаю, что такой подход был бы еще более хрупким.

1. Запустите trace(ggplot2:::merge_element.element, edit = TRUE) и замените

 if (!inherits(new, class(old)[1])) {
  stop("Only elements of the same class can be merged", call. = FALSE)
}
    
  

с помощью

 if (!inherits(new, class(old)[1]) amp; class(new)[1] != "element_gradient") {
  stop("Only elements of the same class can be merged", call. = FALSE)
}
  

2. Запустите trace(ggplot2:::validate_element, edit = TRUE) и замените

 else if (!inherits(el, eldef$class) amp;amp; 
         !inherits(el, "element_blank")) {
  stop("Element ", elname, " must be a ", eldef$class, " object.")
}
  

с помощью

 else if (!inherits(el, eldef$class) amp;amp; 
         !inherits(el, "element_blank") amp;amp; 
         eldef$class != "element_gradient") {
  stop("Element ", elname, " must be a ", eldef$class, " object.")
  

4. Когда закончите, выполните следующее, чтобы положить конец безумию и вернуться к нормальному ggplot поведению:

 ggplot_global.new$element_tree$strip.background <- ggplot2:::el_def("element_rect", "rect")
ggplot_global.new$element_tree$strip.background.x <- ggplot2:::el_def("element_rect", "strip.background")
ggplot_global.new$element_tree$strip.background.y <- ggplot2:::el_def("element_rect", "strip.background")

untrace(ggplot2:::merge_element.element)
untrace(ggplot2:::validate_element)