如何修改 facet_wrap 条的宽度？

Question

我有两个图表：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")

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