9

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

2 Answers 2

6

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

5
  • @Claus_Wilke this is excellent. Not to be greedy, but I'm wondering if you see an extension to more than 2 textbox colors?
    – Eric Green
    Feb 23, 2020 at 21:33
  • 1
    It should be straightforward to rewrite the helper functions. Just add parameters hi.labels2, hi.fill2, etc. and add a second if statement. Feb 24, 2020 at 1:14
  • Ah, that makes sense. Thanks for the tip!!
    – Eric Green
    Feb 24, 2020 at 1:15
  • added an example to your answer (hope that's ok)
    – Eric Green
    Feb 24, 2020 at 2:19
  • 1
    Yes, but I'd recommend you also show how to use this in an actual plot and what the output is. Feb 24, 2020 at 20:51
2

ggh4x package has facet_wrap2 and strip_themed that make facet manipulation very easy.

library(ggplot2)
library(ggtext)
library(ggh4x)

# # match desired color to the `pickup` class
car_class <- sort(unique(mpg$class))
strip_color <- ifelse(car_class == "pickup", "darkred", "darkblue")
strip_color_scale <- setNames(strip_color, car_class)
strip_color_scale
#>    2seater    compact    midsize    minivan     pickup subcompact        suv 
#> "darkblue" "darkblue" "darkblue" "darkblue"  "darkred" "darkblue" "darkblue"

# set strip background color
strip_background <- strip_themed(
  text_x = elem_list_text(colour = "white", face = 'bold'),
  background_x = elem_list_rect(fill = strip_color_scale)
  )

ggplot(mpg, aes(cty, hwy)) + 
  geom_point() +
  # use facet_wrap2 from `ggh4x`
  facet_wrap2(~ class, strip = strip_background) +
  theme_bw(base_size = 12)

Created on 2023-03-27 with reprex v2.0.2

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.