接收面板比例/布局信息的刻面标签器功能

Question

我正在创建一个多面图，其中一个面板比另一个更宽，并且都有相当长的标签。我试图找出一种方法来按照面板的宽度成比例地包裹标签，这样只有在文本太长而无法整齐地放在条带中时才会包裹文本。我想象一些类似于ggfittext, 但用于标签文本的东西。我知道绘图的某些部分是相对的并且取决于屏幕/画布大小，所以我更希望能够说最小的面板应该在给定点破裂，而其他部分应该按比例破裂。

我想出了一种动态设置断点的手动蛮力方法，但它需要绘制两次图并且不能很好地缩放。

没有标签调整的样本数据和绘图：

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

显然，我可以使用带有手动设置断点的字符串包装函数，但这将应用于每个标签，而不管其面板的大小。因此，虽然 40 个字符对于较小的面板来说是一个不错的宽度，但对于较宽的面板来说却没有必要；我宁愿保持更广泛情节的标签不间断。

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

我对绘图的参数进行了一些挖掘，并找到了与每个面板的限制相对应的范围列表。对于其中的每一个，diff是范围的宽度。保留 40 个字符作为较小面板的断点，我可以计算字符数与范围（以及面板宽度）之间的比率，并使用它来为任何其他面板找到成比例的断点。标签函数仅获取标签字符串作为参数，因此我实际上无法将这些值中的任何一个传递给标签函数本身——我只是将它们保留在工作环境中。

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

这得到了我想要的输出，但它很麻烦，感觉它打破了标签器功能的预期逻辑。是否有其他方法可以让调用labeller或其他内容facet_grid找到有关面板范围或大小的布局信息，而无需先保存绘图，然后使用计算出的参数反馈到另一个facet_grid调用中？

Answer 1

我对这个问题有部分答案，希望能激发比我聪明的人得出更完整的答案。

建议的解决方案是用于ggtext::element_textbox()条带文本，它可以根据可用宽度对文本进行换行。然而，我们遇到了一个不同的问题，即无法自动确定换行文本的高度。

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

只是为了表明包装适应不同的宽度，但我们必须调整高度以获得更好的绘图。

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

^{由reprex 包(v1.0.0)创建于 2021-07-08}