Search code examples
rggplot2ggtext

conditionally fill ggtext text boxes in facet_wrap


Is it possible to conditionally fill these [ggtext][1] text boxes? Let's say color "red" if "pickup".

enter image description here

library(cowplot)
library(tidyverse)
library(ggtext)

ggplot(mpg, aes(cty, hwy)) + 
  geom_point() +
  facet_wrap(~class) +
  theme_half_open(12) +
  background_grid() +
  theme(
    strip.background = element_blank(),
    strip.text = element_textbox(
      size = 12,
      color = "white", fill = "#5D729D", box.color = "#4A618C",
      halign = 0.5, linetype = 1, r = unit(5, "pt"), width = unit(1, "npc"),
      padding = margin(2, 0, 1, 0), margin = margin(3, 3, 3, 3)
    )
  )

Solution

  • You can intercept the element drawing routine and inject some styling changes.

    library(ggplot2)
    library(cowplot)
    library(rlang)
    library(ggtext)
    
    
    element_textbox_highlight <- function(..., hi.labels = NULL, hi.fill = NULL,
                                          hi.col = NULL, hi.box.col = NULL) {
      structure(
        c(element_textbox(...),
          list(hi.labels = hi.labels, hi.fill = hi.fill, hi.col = hi.col, hi.box.col = hi.box.col)
        ),
        class = c("element_textbox_highlight", "element_textbox", "element_text", "element")
      )
    }
    
    element_grob.element_textbox_highlight <- function(element, label = "", ...) {
      if (label %in% element$hi.labels) {
        element$fill <- element$hi.fill %||% element$fill
        element$colour <- element$hi.col %||% element$colour
        element$box.colour <- element$hi.box.col %||% element$box.colour
      }
      NextMethod()
    }
    
    
    ggplot(mpg, aes(cty, hwy)) + 
      geom_point() +
      facet_wrap(~class) +
      theme_half_open(12) +
      background_grid() +
      theme(
        strip.background = element_blank(),
        strip.text = element_textbox_highlight(
          size = 12,
          color = "white", fill = "#5D729D", box.color = "#4A618C",
          halign = 0.5, linetype = 1, r = unit(5, "pt"), width = unit(1, "npc"),
          padding = margin(2, 0, 1, 0), margin = margin(3, 3, 3, 3),
          # this is new relative to element_textbox():
          hi.labels = c("minivan", "suv"),
          hi.fill = "#F89096", hi.box.col = "#A6424A", hi.col = "black"
        )
      )
    

    Created on 2020-02-21 by the reprex package (v0.3.0)

    Edit: Extending to 3 (or more colors) based on feedback from @Claus_Wilke

    library(ggplot2)
    library(cowplot)
    library(rlang)
    library(ggtext)
    
    
    element_textbox_highlight <- function(..., 
                                          hi.labels = NULL, hi.fill = NULL,
                                          hi.col = NULL, hi.box.col = NULL,
                                          hi.labels2 = NULL, hi.fill2 = NULL,
                                          hi.col2 = NULL, hi.box.col2 = NULL) {
      structure(
        c(element_textbox(...),
          list(hi.labels = hi.labels, hi.fill = hi.fill, hi.col = hi.col, hi.box.col = hi.box.col,
               hi.labels2 = hi.labels2, hi.fill2 = hi.fill2, hi.col2 = hi.col2, hi.box.col2 = hi.box.col2)
        ),
        class = c("element_textbox_highlight", "element_textbox", "element_text", "element",
                  "element_textbox_highlight", "element_textbox", "element_text", "element")
      )
    }
    
    element_grob.element_textbox_highlight <- function(element, label = "", ...) {
      if (label %in% element$hi.labels) {
        element$fill <- element$hi.fill %||% element$fill
        element$colour <- element$hi.col %||% element$colour
        element$box.colour <- element$hi.box.col %||% element$box.colour
      }
      if (label %in% element$hi.labels2) {
        element$fill <- element$hi.fill2 %||% element$fill
        element$colour <- element$hi.col2 %||% element$colour
        element$box.colour <- element$hi.box.col2 %||% element$box.colour
      }
      NextMethod()
    }
    
    
    ggplot(mpg, aes(cty, hwy)) + 
      geom_point() +
      facet_wrap(~class) +
      theme_half_open(12) +
      background_grid() +
      theme(
        strip.background = element_blank(),
        strip.text = element_textbox_highlight(
          size = 12,
          # unnamed set (all facet windows except named sets below)
          color = "white", fill = "#5D729D", box.color = "#4A618C",
          halign = 0.5, linetype = 1, r = unit(5, "pt"), width = unit(1, "npc"),
          padding = margin(2, 0, 1, 0), margin = margin(3, 3, 3, 3),
          # this is new relative to element_textbox():
          # first named set
          hi.labels = c("minivan", "suv"),
          hi.fill = "#F89096", hi.box.col = "#A6424A", hi.col = "black",
          # add second named set 
          hi.labels2 = c("compact", "pickup"),
          hi.fill2 = "green", hi.box.col2 = "#A6424A", hi.col2 = "black"
        )
      )
    

    enter image description here