如何修改facet_wrap条带的宽度?

How to modify the width of a facet_wrap strip?

我有两个图表:FigA 和 FigB。两者都是多面包裹的。 FigA 基于短因子标签进行分面,而 FigB 基于更长的因子标签进行分面。 FigA 和 FigB 共享一个 x-axis,所以我想垂直显示它们(通过 cowplot),条带标签位于图的右侧,并带有水平文本。

这导致 FigA 的短条标签周围有很多白色 space。

格式化条形标签背景以便它们扩展以填充可用的水平区域的最佳方法是什么space?

我一直在尝试 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")

对于需要堆叠两个独立图的情况,这里有一种匹配条带宽度的方法:

  • 加载 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))