r - 在 facet_wrap 标签上显示注释

Question

我正在尝试使用 facet_wrap 将标签(a、b、c...)添加到实际图的边缘之外的图。我希望将它们放在标签区域中，但与 facet_wrap 标签(这是数据组的名称)分开。我可以使用 coord_cartesian(clip = "off") 将文本推到图的边界之外，但是 facet_wrap 创建的标签背景会阻止注释。我可以使用 theme(strip.background = element_blank()) 来抑制标签背景，这使得注释可见，但从美学上讲我更喜欢有背景。有什么方法可以使 geom_text 注释出现在 facet_wrap 标签上方而不是下方？

这是一个例子:

df <- data.frame(x=rep(1:3, 4), mydat=rep(c('apple', 'kiwi', 'orange', 'pear'), each=3))
labels <- data.frame(mydat=as.factor(c('apple', 'kiwi', 'orange', 'pear')), 
                     label=paste0('(', letters[1:4], ')'))

ggplot(df, aes(x,x)) +
  facet_wrap(~mydat) +
  geom_point() +
  geom_text(data = labels, aes(label=label), #geom_text or geom_label
            x = -Inf, y = Inf, hjust=0, vjust=0,
            inherit.aes = FALSE) + 
  #theme(strip.background = element_blank()) +
  coord_cartesian(clip = "off")

有了 facet_wrap 背景:

没有 facet_wrap 背景:

Answer 1

一个选项是 ggh4x 包，它提供了一些对默认方面有用的扩展，例如使用 ggh4x::facet_wrap2，您可以将注释添加为第二层方面。此外，ggh4x::facet_wrap2 允许通过 strip 参数分别设置两层的样式:

df <- data.frame(x = rep(1:3, 4), mydat = rep(c("apple", "kiwi", "orange", "pear"), each = 3))
labels <- data.frame(
  mydat = as.factor(c("apple", "kiwi", "orange", "pear")),
  label = paste0("(", letters[1:4], ")")
)

df <- merge(df, labels, by = "mydat")

library(ggplot2)
library(ggh4x)

ggplot(df, aes(x, x)) +
  facet_wrap2(vars(label, mydat),
    strip = strip_themed(
      background_x = list(
        element_blank(),
        element_rect(fill = "grey85")
      ),
      text_x = list(
        element_text(hjust = 0),
        element_text()
      ),
      by_layer_x = TRUE
    )
  ) +
  geom_point() +
  coord_cartesian(clip = "off")

更新 正如您在评论中提到的，您希望将注释作为 strip 标签的一部分以节省垂直空间。恕我直言，最简洁的方法是将注释添加为 facet 标签的一部分。正如操作 gtable 的练习一样，我编写了一个自定义函数，它允许用字母 a、b、... 标记构面:

library(ggplot2)
library(grid)

g <- ggplot(df, aes(x, x)) +
  facet_wrap(~mydat) +
  geom_point() +
  coord_cartesian(clip = "off")

add_tag <- function(gg) {
  # Indices of strips in gtable
  ix_strips <- grep('strip', gg$layout$name)
  strips <- gg$grobs[ix_strips]
  # Strip positions
  strip_rc <- gsub("^.*?(\\d+)\\-(\\d+)$", "\\2-\\1", gg$layout$name[ix_strips])
  
  tag_order <- order(strip_rc)

  gg$grobs[ix_strips] <- mapply(function(x, y) {
    tag <- x$grobs[[1]]$children[[2]]
    tag$children[[1]]$label <- paste0("(", letters[[y]], ")")
    tag$children[[1]]$hjust <- 0
    tag$children[[1]]$x <- unit(0, "npc")
    
    x$grobs[[1]]$children[[2]] <- gList(
      tag, x$grobs[[1]]$children[[2]]   
    )
    
    x
  }, strips, tag_order)
  
  gg
}

gg = ggplotGrob(g)

gg <- add_tag(gg)

grid.draw(gg)