用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的其他值也会发生同样的情况。看看这个函数的来源，我看到了一个指向这个问题的行：

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

如果%||%为null，则x$data$hjust分配0.5。据我所知，这是我所理解的，但我设置的hjust似乎并没有转移到这个位置，而是出现了空值。

我错过了什么吗？有人能看到我可以在不重新实现整个算法的情况下重写这个算法吗？还是这里有个错误掉了我的hjust

Answer 1

TL;DR:可能是一种小虫子

较长的答覆：

我想这可能是代码中的一个bug。我检查了您所绘制的图的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()的makeTextRepelGrobs()并没有传递给resolveHJust()，这似乎是您的hjust参数意外被删除的地方。

下面的代码是生成实际文本grobs的地方：

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

我认为修复相对简单:您只需提供hjust作为resolveHJust()的第二个参数即可。但是，由于该makeTextRepelGrobs()是ggrepel内部的，并且不能导出，因此您必须复制大量额外的代码才能使其工作。(不确定仅仅复制makeTextRepelGrob()是否足够，还没有对此进行测试)

所有这些都让我得出结论，您在hjust中指定的geom_text_repel()在拖放时间的最后一刻会被makeTextRepelGrobs()内部函数丢失。

Answer 2

更新(2019年12月12日)：

FYI，这个问题现在在ggrepel的开发版本中得到了解决，并且修复也适用于geom_label_repel。参见第137期 on GitHub。

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

​

​