如何修改 facet_wrap 条的宽度？

Posted 2023-02-16

【中文标题】如何修改 facet_wrap 条的宽度？

【英文标题】：How to modify the width of a facet_wrap strip?

【发布时间】：2021-11-03 17:22:07

【问题描述】：

我有两个图表：FigA 和 FigB。两者都是刻面包裹的。 FigA 是基于短因子标签的刻面，而 FigB 是基于更长的因子标签的刻面。 FigA 和 FigB 都共享一个 x 轴，因此我想垂直显示它们（通过 cowplot），带状标签位于绘图的右侧，并带有水平文本。

这会导致 FigA 的短条标签周围出现大量空白。

设置条形标签背景以使其扩展以填充可用水平空间的最佳方式是什么？

我一直在使用 strip.background 和 strip.text 边距、大小和其他参数，但到目前为止还没有产生预期的结果。我错过了什么明显的东西吗？

下面是一个最小的例子

（我意识到我可能可以通过这个简单的示例进行 pivot_longer 并生成一个图表，但是有没有办法直接修改条形标签以适应更复杂的情况？）：

library(tidyverse)
library(cowplot)
df <- data.frame(   shortCat = sample(c('a','b'), 10, replace=TRUE),
                    longCat = sample(c('a really long label','another really long label'), 10, replace=TRUE),
                    x = sample(seq(as.Date('2020/01/01'), as.Date('2020/12/31'), by="day"), 10),
                    y = sample(0:25, 10, replace = TRUE) )

figA <- df %>% ggplot( aes(x=x,y=y) ) +      
    geom_line() + 
    facet_wrap(vars(shortCat), ncol=1, strip.position ="right", scales="free_y") + 
    theme(  axis.title.y=element_blank(),
            axis.title.x=element_blank(),
            axis.text.x=element_blank(),
            axis.ticks.x=element_blank(), 
            strip.text.y.right = element_text(angle = 0, hjust=0) )

figB <- df %>% ggplot( aes(x=x,y=y) ) +      
    geom_bar(stat="identity") + 
    facet_wrap(vars(longCat), ncol=1, strip.position ="right", scales="free_y") + 
    theme(  axis.title.y=element_blank(),
            strip.text.y.right = element_text(angle = 0, hjust=0) )

plot_grid(figA,figB, ncol=1, align="v")

【参考方案1】：

对于需要堆叠两个单独的图的情况，这是一种匹配条带宽度的方法：

加载ggtext 包，它允许我们在单个条形标签中拥有多种文本颜色（使用html标签）。 获取最长条形标签的全文。将其作为 第二行 添加到短条标签中（我们将添加一个 html 标记来执行此操作）。此文本将确保两个图中的条带宽度完全相同。 但是，我们不希望额外的文本行可见。所以我们会添加一些html标签来设置这个文本的颜色和条带的背景填充颜色一样。

library(tidyverse)
library(patchwork) # For plot layout
library(ggtext) # For multiple text colors in strip labels
theme_set(theme_bw())

set.seed(2)
df <- data.frame(shortCat = sample(c('a','b'), 10, replace=TRUE),
                 longCat = sample(c('a really long label','another really long label'), 10, replace=TRUE),
                 x = sample(seq(as.Date('2020/01/01'), as.Date('2020/12/31'), by="day"), 10),
                 y = sample(0:25, 10, replace = TRUE) )

# Test method's robustness by making labels of different lengths
df = df %>% 
  mutate(shortCat2 = gsub("b", "medium label", shortCat))

# Get text of longest label
pad = df$longCat[which.max(nchar(df$longCat))]

# Get colour of strip background
txt.col = theme_get()$strip.background$fill

# Set padding text to same colour as background, so it will be invisible
#  (you can set the color to "white" for a visual confirmation of what this does)
df$shortCat2 = paste0(df$shortCat2,  "<span style = 'color:",txt.col,";'><br>", pad ,"</span>")

figA = df %>%
  ggplot( aes(x=x,y=y) ) +
  geom_line() +
  facet_wrap(vars(shortCat2), ncol=1, strip.position ="right", scales="free_y") +
  theme(axis.title.y=element_blank(),
        axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        strip.text.y=element_textbox())

figA / figB

这是另一种方法，我们添加空格以将条形标签扩展到所需的宽度。它需要等宽字体，这使得它不太灵活，但它不需要像以前的方法那样使用 html 标签。

# Identify monospaced fonts on your system
fonts = systemfonts::system_fonts()
fonts %>% filter(monospace) %>% pull(name)
#>  [1] "Menlo-Bold"                "Courier-Oblique"          
#>  [3] "Courier-BoldOblique"       "AppleBraille"             
#>  [5] "AppleBraille-Pinpoint8Dot" "AndaleMono"               
#>  [7] "Menlo-BoldItalic"          "Menlo-Regular"            
#>  [9] "CourierNewPS-BoldMT"       "AppleBraille-Outline6Dot" 
#> [11] "GB18030Bitmap"             "Monaco"                   
#> [13] "AppleBraille-Outline8Dot"  "PTMono-Regular"           
#> [15] "PTMono-Bold"               "AppleColorEmoji"          
#> [17] "Menlo-Italic"              "CourierNewPS-ItalicMT"    
#> [19] "Courier"                   "Courier-Bold"             
#> [21] "CourierNewPSMT"            "AppleBraille-Pinpoint6Dot"
#> [23] "CourierNewPS-BoldItalicMT"

# Set theme to use a monospace font
theme_set(theme_bw() + 
            theme(text=element_text(family="Menlo-Regular")))

figA <- df %>%
  mutate(shortCat = paste0(shortCat, 
                           paste(rep(" ", max(nchar(longCat)) - 1), collapse=""))
  ) %>%
  ggplot( aes(x=x,y=y) ) +
  geom_line() +
  facet_wrap(vars(shortCat), ncol=1, strip.position ="right", scales="free_y") +
  theme(axis.title.y=element_blank(),
        axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        strip.text.y.right = element_text(angle = 0, hjust=0))

figB <- df %>% ggplot( aes(x=x,y=y) ) +
  geom_line() +
  facet_wrap(vars(longCat), ncol=1, strip.position ="right", scales="free_y") +
  theme(  axis.title.y=element_blank(),
          strip.text.y.right = element_text(angle = 0, hjust=0) )

figA / figB

如果您可以将数据重新整形为长格式并制作单个图，这是最直接的方法：

theme_set(theme_bw())

df %>% 
  pivot_longer(matches("Cat")) %>% 
  mutate(value = fct_relevel(value, "a", "b")) %>% 
  ggplot(aes(x,y)) +
  geom_line() +
  facet_wrap(~value, ncol=1, strip.position="right") +
  theme(strip.text.y=element_text(angle=0, hjust=0))

【讨论】：

感谢@eipi10，这非常有用。我会看看这个。我可以确认没有主题支持以我尝试的方式操作条带背景吗？

我不知道如何设置绝对条带宽度而不破解条带 grobs。但是，我在答案中添加了一种新方法作为第二个选项。这有点小技巧，但我认为它足够灵活，可以在相对一般的情况下工作。

谢谢@eipi10，太好了！我已经稍微修改了我的问题，以更清楚地说明为什么组合图而不是重塑数据可能是首选选项，以防万一这会激发任何其他解决方法。但除此之外，感谢您提供如此完整的选择范围！

不客气！鉴于您的问题的更新，我已将两个组合单独的绘图选项移至顶部，将单绘图选项移至底部。