Facet labeller function that receives panel scale / layout information

Question

I'm creating a facetted plot where one panel is wider than the other, and both have fairly long labels. I'm trying to figure out a way to wrap the labels in proportion to the width of the panels, such that text is only wrapped if it's too long to fit neatly in its strip. I imagine something similar to ggfittext, but for label text. I know some parts of the plot drawing are relative & dependent on screen / canvas size, so it's more that I'd like to be able to say the smallest panel should break at a given point, and others should break in proportion.

I came up with a manual, brute-force method of dynamically setting breakpoints, but it requires drawing the plot twice and isn't going to scale well.

Sample data and plot with no label adjustments:

library(purrr)
library(ggplot2)

df <- tibble::tribble(
  ~field, ~group, ~value,
  "Computer science, mathematics, biology, engineering",           "A", 65,
  "Computer science, mathematics, biology, engineering",           "B", 55,
  "English, social sciences, history, visual and performing arts", "A", 30,
  "English, social sciences, history, visual and performing arts", "B", 25
)

p <- ggplot(df, aes(x = group, y = value)) +
  geom_col() +
  coord_flip() 

p_facet <- p + facet_grid(cols = vars(field), scales = "free_x", space = "free")
p_facet

Obviously I can use a string wrapping function with a manually-set breakpoint, but that will be applied to every label regardless of the size of its panel. So while 40 characters is a good width for the smaller panel, it's unnecessary for the wider one; I'd rather keep the label for the wider plot unbroken.

p + facet_grid(cols = vars(field), scales = "free_x", space = "free",
               labeller = labeller(.cols = label_wrap_gen(40)))

I did some digging into parameters of the plot, and found this list of ranges corresponding to the limits of each panel. For each of those, the diff is the width of the range. Keeping 40 characters as a breakpoint for the smaller panel, I can calculate a ratio between number of characters and range (and therefore panel width), and use that to find proportionate breakpoints for any other panels. Labeller functions only get the label strings as arguments, so I can't actually pass any of those values to the label function itself—I'm just keeping them in the working environment.

ranges <- ggplot_build(p_facet)$layout$panel_params %>%
  map(pluck, "x", "continuous_range")
ranges
#> [[1]]
#> [1] -3.25 68.25
#> 
#> [[2]]
#> [1] -1.5 31.5

widths <- map_dbl(ranges, diff)
ratio <- 40 / min(widths)
# 40 / base_width = x1 / width1

p + facet_grid(cols = vars(field), scales = "free_x", space = "free",
               labeller = labeller(.cols = function(labels) {
                 brkpts <- map_dbl(widths, ~round(. * ratio))
                 map2_chr(labels, brkpts, stringr::str_wrap)
               }))

This gets the output I want, but it's cumbersome and feels like it breaks the intended logic of labeller functions. Is there some other way that either the call to labeller or something else in facet_grid can find layout information about the panel ranges or sizes, without having to first save the plot, and then use calculated parameters to feed back into another facet_grid call?

Answer 1

I have a partial answer to this question, which hopefully might spark something in someone smarter than me to arrive at a more complete answer.

The proposed solution is to use ggtext::element_textbox() for the strip text, which can wrap text depending on the available width. However, we're then left with a different problem, which is that the height of the wrapped text can't be automatically determined.

library(purrr)
library(ggplot2)
library(ggtext)
library(patchwork)

df <- tibble::tribble(
  ~field, ~group, ~value,
  "Computer science, mathematics, biology, engineering",           "A", 65,
  "Computer science, mathematics, biology, engineering",           "B", 55,
  "English, social sciences, history, visual and performing arts", "A", 30,
  "English, social sciences, history, visual and performing arts", "B", 25
)

p <- ggplot(df, aes(x = group, y = value)) +
  geom_col() +
  coord_flip() +
  facet_grid(cols = vars(field), scales = "free_x", space = "free") +
  theme(
    strip.text.x = element_textbox(
      # relative fontsize = 0.8 for default strips
      height = unit(3 * 0.8, "lines"), 
      width  = unit(1, "npc"),
      margin = margin(4.4, 4.4, 4.4, 4.4),
      halign = 0.5, valign = 0.5
    )
  )

p

Just to show that the wrapping adapts to different widths, but we'd have to adjust the height to get a nicer plot.

p + p & theme(strip.text.x.top = element_textbox(height = unit(5, "lines")))

^{Created on 2021-07-08 by the reprex package (v1.0.0)}