用ggrepel覆盖水平定位

Question

我正在制作一个类似于坡度图的图表，我想在其中的一侧或两侧放置标签，并留出足够的空白空间以适应它们的两侧。在标签很长的情况下，我使用stringr::str_wrap 将它们包裹起来以放置换行符。为了防止标签重叠，我将ggrepel::geom_text_repel 与direction = "y" 一起使用，因此x 位置是稳定的，但y 位置相互排斥。我还有 hjust = "outward" 将左侧文本与右端对齐，反之亦然。

然而，排斥定位似乎将标签的边界框放置在hjust = "outward"，但文本在该标签具有hjust = 0.5，即文本在其边界内居中。到现在为止，我从未注意到这一点，但是使用包裹标签时，第二行居中很尴尬，而我希望看到两行都左对齐或右对齐。

这是一个基于 mpg 数据集构建的示例。

library(ggplot2)
library(dplyr)
library(ggrepel)

df <- structure(list(long_lbl = c("chevrolet, k1500 tahoe 4wd, auto(l4)", 
                                  "chevrolet, k1500 tahoe 4wd, auto(l4)", "subaru, forester awd, manual(m5)", 
                                  "subaru, forester awd, manual(m5)", "toyota, camry, manual(m5)", 
                                  "toyota, camry, manual(m5)", "toyota, toyota tacoma 4wd, manual(m5)", 
                                  "toyota, toyota tacoma 4wd, manual(m5)", "volkswagen, jetta, manual(m5)", 
                                  "volkswagen, jetta, manual(m5)"), year = c(1999L, 2008L, 1999L, 
                                                                             2008L, 1999L, 2008L, 1999L, 2008L, 1999L, 2008L), mean_cty = c(11, 
                                                                                                                                            14, 18, 20, 21, 21, 15, 17, 33, 21)), class = c("tbl_df", "tbl", 
                                                                                                                                                                                            "data.frame"), row.names = c(NA, -10L))

df_wrap <- df %>%  
  mutate(wrap_lbl = stringr::str_wrap(long_lbl, width = 25))

ggplot(df_wrap, aes(x = year, y = mean_cty, group = long_lbl)) +
  geom_line() +
  geom_text_repel(aes(label = wrap_lbl),
                  direction = "y", hjust = "outward", seed = 57, min.segment.length = 100) +
  scale_x_continuous(expand = expand_scale(add = 10))

hjust 的其他值也会发生同样的情况。查看函数的source，我看到了指向这个问题的一行：

hjust = x$data$hjust %||% 0.5,

如果x$data$hjust 为空，则%||% 分配0.5。据我了解，但似乎我设置的hjust 并没有延续到这个位置，而是变为空。

我错过了什么吗？谁能在不重新实现整个算法的情况下看到我可以在哪里覆盖它？还是这里有错误导致我的hjust 丢失？

Answer 1

TL;DR：可能是一个错误

长答案：

我认为这可能是代码中的错误。我检查了您制作的绘图的 gtable，其中 hjust 以数字方式正确指定：

# Assume 'g' is the plot saved under the variable 'g'
gt <- ggplotGrob(g)
# Your number at the end of the geom may vary
textgrob <- gt$grobs[[6]]$children$geom_text_repel.textrepeltree.1578
head(textgrob$data$hjust)

[1] 1 0 1 0 1 0

这让我想到 (1) 无法通过在 gtable 中乱搞来修复情节，以及 (2) textrepeltree grobs 类的绘制时间代码可能包含一些错误。这是有道理的，因为在调整绘图设备大小时会重新定位标签。因此，当我们查看您提供的链接中的makeContent.textrepeltree() 代码时，我们可以看到hjust 参数被传递给makeTextRepelGrobs()。我们来看看相关的形式：

makeTextRepelGrobs <- function(
  ...other_arguments...,
  just = "center",
  ...other_arguments...,
  hjust = 0.5,
  vjust = 0.5
) { ...body...}

我们可以看到hjust 是一个有效的参数，但也存在一个just 参数，这是一个不是从makeContent.textrepeltree() 传递的参数。

当我们查看函数体时，有以下两行：

  hj <- resolveHJust(just, NULL)
  vj <- resolveVJust(just, NULL)

其中resolveH/VJust 是从网格包中导入的。 resolveHJust() 本质上检查第二个参数是否为NULL，如果是，则默认为第一个参数，否则返回第二个参数。您可以看到传递给makeTextRepelGrobs() 的hjust 没有传递给resolveHJust()，这似乎是您的hjust 参数被意外删除的地方。

代码的下方是实际的文本 grobs 的生成位置：

  t <- textGrob(
    ...other_arguments...
    just = c(hj, vj),
    ...other_arguments...
  )

我想修复会相对简单：您只需提供hjust 作为resolveHJust() 的第二个参数。但是，由于 makeTextRepelGrobs() 是 ggrepel 内部的并且不会被导出，因此您必须复制大量额外的代码才能使其正常工作。 （不确定是否只复制makeTextRepelGrob() 就足够了，还没有测试过）

所有这一切让我得出结论，您在geom_text_repel() 中指定的hjust 在绘制时间的最后一刻被makeTextRepelGrobs() 内部函数丢失了。

Answer 2

更新（2019 年 12 月 12 日）：

仅供参考，此问题现已在 ggrepel 的开发版本中得到解决，该修复也适用于 geom_label_repel。请参阅 GitHub 上的 issue #137。

library(ggplot2)
library(dplyr)
devtools::install_github("slowkow/ggrepel")


df <- structure(list(long_lbl = c("chevrolet, k1500 tahoe 4wd, auto(l4)", 
                                  "chevrolet, k1500 tahoe 4wd, auto(l4)", "subaru, forester awd, manual(m5)", 
                                  "subaru, forester awd, manual(m5)", "toyota, camry, manual(m5)", 
                                  "toyota, camry, manual(m5)", "toyota, toyota tacoma 4wd, manual(m5)", 
                                  "toyota, toyota tacoma 4wd, manual(m5)", "volkswagen, jetta, manual(m5)", 
                                  "volkswagen, jetta, manual(m5)"), year = c(1999L, 2008L, 1999L, 
                                                                             2008L, 1999L, 2008L, 1999L, 2008L, 1999L, 2008L), mean_cty = c(11, 
                                                                                                                                            14, 18, 20, 21, 21, 15, 17, 33, 21)), class = c("tbl_df", "tbl", 
                                                                                                                                                                                            "data.frame"), row.names = c(NA, -10L))

df_wrap <- df %>%  
  mutate(wrap_lbl = stringr::str_wrap(long_lbl, width = 25))

# With geom_text_repel
ggplot(df_wrap, aes(x = year, y = mean_cty, group = long_lbl)) +
  geom_line() +
  geom_text_repel(aes(label = wrap_lbl),
                  hjust = "outward",
                  direction = "y",
                  seed = 57,
                  min.segment.length = 100) +
  scale_x_continuous(expand = expansion(add = 10))

# With geom_label_repel
ggplot(df_wrap, aes(x = year, y = mean_cty, group = long_lbl)) +
  geom_line() +
  geom_label_repel(aes(label = wrap_lbl),
                  hjust = "outward",
                  direction = "y",
                  seed = 57,
                  min.segment.length = 100) +
  scale_x_continuous(expand = expansion(add = 10))