删除ggplot2中标签/文本周围的段

Question

考虑一个带有线段/线和文本/标签的图。我希望文本覆盖该段，以便文本不与该段重叠。

我尝试使用，geom_label但我仍然希望背景相同，只是删除文本周围的其他对象。我也尝试过，geomtextpath但无法使文本水平。有任何想法吗？

seg <- data.frame(x = 1, xend = 1, y = 2, yend = 3)
plot1 <- ggplot(seg) +
  aes(x = x, xend = xend, y = y, yend = yend) +
  geom_segment() +
  geom_text(aes(y = (y + yend) / 2), label = "Hello", size = 10) +
  labs(title = "geom_text", 
       subtitle = "The text is horizontal but the segment should\nbe cut around the text.")

library(geomtextpath)
plot2 <- ggplot(seg) +
  aes(x = x, xend = xend, y = y, yend = yend) +
  geom_textsegment(label = "Hello", size = 10) +
  labs(title = "geomtextpath",
       subtitle = "The segment is correctly overlaid but\nI need the text to be horizontal")

seg2 <- data.frame(x = c(1, 1), xend = c(1, 1), y = c(2, 2.55), yend = c(2.45, 3))
plot3 <- ggplot(seg2) +
  aes(x = x, xend = xend, y = y, yend = yend) +
  geom_segment() +
  geom_text(aes(y = 2.5), label = "Hello", size = 10) +
  labs(title = "manual geom_segment", 
       subtitle = "This is the expected output, but it is done\nmanually. I need a scalable solution.")

library(patchwork)
plot1 + plot2 + plot3

Answer 1

我不会说以下内容很“简单”，但您可以使用 {ggfx} 包在与文本框对应的段上放置反转掩码。

library(ggplot2)
library(ggfx)

seg <- data.frame(x = 1, xend = 1, y = 2, yend = 3)

ggplot(seg) +
  aes(x = x, xend = xend, y = y, yend = yend) +
  # Adding a label-textbox as mask ensures appropriate window-agnostic size
  # Just make sure the aesthetics are the same as the geom_text later
  as_reference(
    geom_label(aes(y = (y + yend) / 2), label = "Hello", size = 10),
    id = "textbox"
  ) +
  # Plot the masked bit
  with_mask(
    geom_segment(),
    mask = ch_alpha("textbox"), invert = TRUE
  ) +
  # On top of the mask
  geom_text(aes(y = (y + yend) / 2), label = "Hello", size = 10)

^{由reprex 包于 2022 年 10 月 14 日创建(v2.0.1)}

编辑：

有点更通用的功能。但请注意，此选项要求您在功能中设置美观性。

library(ggplot2)
library(ggfx)

geom_text_segment <- function(mapping, ...) {

  # Divide up the mapping to the segment and text
  segment_mapping <- mapping
  segment_mapping$label <- NULL
  segment_mapping$xmiddle <- segment_mapping$ymiddle <- NULL
  
  text_mapping <- mapping
  text_mapping$yend <- text_mapping$xend <- NULL
  text_mapping$y <- text_mapping$ymiddle
  text_mapping$x <- text_mapping$xmiddle
  text_mapping$xmiddle <- text_mapping$ymiddle <- NULL
  
  list(
    as_reference(
      geom_label(text_mapping, ...),
      id = "textbox"
    ),
    with_mask(
      geom_segment(segment_mapping, ...),
      mask = ch_alpha("textbox", invert = TRUE)
    ),
    geom_text(text_mapping)
  )
}

例子：

seg <- data.frame(
  xstart = c(0, 1),
  xend   = c(2, 1),
  ystart = c(0.7, 0),
  yend   = c(0.7, 1),
  label  = c("First", "Second")
)

ggplot(seg) +
  geom_text_segment(
    aes(x = xstart, xend = xend, y = ystart, yend = yend, 
        xmiddle = (xstart + xend) / 2,
        ymiddle = (ystart + yend) / 2,
        label = label)
  )

^{由reprex 包于 2022 年 10 月 17 日创建(v2.0.1)}

您可以根据需要编辑该函数。如果您想传递label.padding给该geom_label()部分（以控制删除多少段），您可以将其作为参数添加到函数并将其转发到geom_label(). 您可以继续添加所有特定于层的功能，直到它满足您的需求，但我来这里是为了回答问题，而不是开发一个待用包。

Answer 2

如果不编写新的Geomggproto 对象（或将其作为功能添加到 geomtextpath 中），将很难获得功能齐全的 geom 层。但是，我们可以使用 geomtextpath 来生成断线，方法是使其文本不可见，并根据不可见文本的宽高比缩小来获得正确的断线高度。然后我们只需在中间添加一个文本标签即可。

请注意，这意味着需要传递 x、y、xend、yend 和 label，而不是将其映射为美观，因此它的作用更像是注释层，而不是真正的几何层：

library(geomtextpath)
#> Loading required package: ggplot2

geom_segment_text <- function(label = NULL, data = NULL, mapping = NULL,
                              inherit.aes = TRUE, x, xend, y, yend, ...,
                              size = 11/.pt, linecolour = "black") {
  
  df <- data.frame(x = x, y = y, xend = xend, yend = yend, label = label)
  ts <- textshaping::shape_text(label)$metric
  ratio <- ts$height / ts$width * 0.6
  list(
    geom_segment(aes(x, y, xend = xend, yend = yend), data = df, colour = NA),
    layer(geom = "text", stat = "identity", data = df, 
          mapping = aes((x + xend)/2, (y + yend)/2, label = label),
          position = "identity",
          params = list(size = size, ...), inherit.aes = inherit.aes),
    layer(geom = "textsegment", stat = "identity", data = df, 
          mapping = aes(x, y, xend = xend, yend = yend, label = label),
          position = "identity",
          params = list(colour = NA, size = size * ratio, 
                        linecolour = linecolour, padding = unit(0, "mm"), ...),
          inherit.aes = inherit.aes)
  )
}

这允许：

ggplot() +
  geom_segment_text(label = "Hello", size = 10, x = 1, y = 2, xend = 1, yend = 3)

我们可以看到，如果更改文本大小，换行符会适当缩放。至关重要的是，因为我们使用的是 geomtextpath，所以如果调整图像大小，文本周围的行间距保持不变：

ggplot() +
  geom_segment_text(label = "Hello", size = 20, x = 1, y = 2, xend = 1, yend = 3)

^{创建于 2022 年 10 月 18 日，使用reprex v2.0.2}