r - 通过 geom_label_repel 向 ggplot 添加一个带有填充头部的箭头

Question

我想使用 geom_label_repel 向 ggplot 对象添加一个带有填充头部的箭头功能。我以为我可以使用:arrow.fill = 'black'就像我对 geom_segment 所做的那样，但它在 geom_label_repel 中不起作用.这是获得填充箭头的另一种方法吗？
我使用geom_label_repel的原因是这是我设法在标签边界处开始箭头的唯一方法。如果可以通过其他方式找到此坐标，我可以使用 geom_segment反而。

library(tidyverse)
library(ggrepel)

dmax <- iris %>%
  filter(Sepal.Length == max(Sepal.Length))

ggplot(data = iris, aes(x=Sepal.Width, y=Sepal.Length)) +
  geom_point() +
  geom_label_repel(data=dmax, aes(label = 'max'), 
                   box.padding = unit(.25, 'lines'), 
                   point.padding = unit(1.5, 'lines'), 
                   arrow = arrow(length = unit(0.25, 'cm'), type = 'closed')) +
  geom_segment(aes(x=3, xend=max(Sepal.Width), y=0, yend=max(Sepal.Width)), 
               arrow=arrow(length = unit(0.25, 'cm'), type = 'closed'), 
               arrow.fill = 'black')

Answer 1

我们可以从GeomSegment$draw_panel看到arrow.fill值在 geom_segment传递给 fill grid::segmentsGrob 中的参数.相同的修改可以应用于 ggrepel::geom_label_repel :

ggplot(data = iris, 
       aes(x=Sepal.Width, y=Sepal.Length)) +
  geom_point() +
  geom_label_repel2(data=. %>% 
                      filter(Sepal.Length == max(Sepal.Length)), 
                    aes(label = 'max'), 
                    box.padding = unit(.25, 'lines'), 
                    point.padding = unit(1.5, 'lines'), 
                    arrow = arrow(length = unit(0.25, 'cm'), type = 'closed'),
                    arrow.fill = "green") +
  geom_segment(aes(x=3, xend=max(Sepal.Width), y=0, yend=max(Sepal.Width)), 
               arrow = arrow(length = unit(0.25, 'cm'), type = 'closed'), 
               arrow.fill = 'red')

修改后的 ggproto 对象和 geom 函数的代码:

GeomLabelRepel2 <- ggproto(
  "GeomLabelRepel2",
  GeomLabelRepel,
  draw_panel = function (self, data, panel_scales, coord, parse = FALSE, na.rm = FALSE, 
                         box.padding = 0.25, label.padding = 0.25, point.padding = 1e-06, 
                         label.r = 0.15, label.size = 0.25, segment.colour = NULL, 
                         segment.size = 0.5, segment.alpha = NULL, min.segment.length = 0.5, 
                         arrow = NULL, arrow.fill = NULL, # add arrow.fill parameter
                         force = 1, nudge_x = 0, nudge_y = 0, xlim = c(NA, NA), 
                         ylim = c(NA, NA), max.iter = 2000, direction = "both", seed = NA) 
  {
    lab <- data$label
    if (parse) {
      lab <- parse(text = as.character(lab))
    }
    if (!length(which(ggrepel:::not_empty(lab)))) {
      return()
    }
    nudges <- data.frame(x = data$x + nudge_x, y = data$y + nudge_y)
    nudges <- coord$transform(nudges, panel_scales)
    data <- coord$transform(data, panel_scales)
    nudges$x <- nudges$x - data$x
    nudges$y <- nudges$y - data$y
    limits <- data.frame(x = xlim, y = ylim)
    limits <- coord$transform(limits, panel_scales)
    limits$x[is.na(limits$x)] <- c(0, 1)[is.na(limits$x)]
    limits$y[is.na(limits$y)] <- c(0, 1)[is.na(limits$y)]
    if (is.character(data$vjust)) {
      data$vjust <- compute_just(data$vjust, data$y)
    }
    if (is.character(data$hjust)) {
      data$hjust <- compute_just(data$hjust, data$x)
    }
    if(is.null(arrow.fill)) { # define fill if arrow.fill is specified
      arrow.fill.gp <- grid::gpar()
    } else {
      arrow.fill.gp <- grid::gpar(fill = arrow.fill)
    }
    ggplot2:::ggname("geom_label_repel", 
                     grid::gTree(limits = limits, 
                                 data = data, 
                                 lab = lab, 
                                 nudges = nudges, 
                                 box.padding = ggrepel:::to_unit(box.padding), 
                                 label.padding = ggrepel:::to_unit(label.padding), 
                                 point.padding = ggrepel:::to_unit(point.padding), 
                                 label.r = ggrepel:::to_unit(label.r), 
                                 label.size = label.size, 
                                 segment.colour = segment.colour,
                                 segment.size = segment.size, 
                                 segment.alpha = segment.alpha, 
                                 min.segment.length = ggrepel:::to_unit(min.segment.length), 
                                 arrow = arrow, 
                                 gp = arrow.fill.gp, # add gp
                                 force = force, 
                                 max.iter = max.iter, 
                                 direction = direction, 
                                 seed = seed, 
                                 cl = "labelrepeltree"))
  }
)

geom_label_repel2 <- function (mapping = NULL, data = NULL, stat = "identity", 
                               position = "identity", parse = FALSE, ..., box.padding = 0.25, 
                               label.padding = 0.25, point.padding = 1e-06, label.r = 0.15, 
                               label.size = 0.25, segment.colour = NULL, segment.color = NULL, 
                               segment.size = 0.5, segment.alpha = NULL, min.segment.length = 0.5, 
                               arrow = NULL, arrow.fill = NULL, # add arrow.fill parameter
                               force = 1, max.iter = 2000, nudge_x = 0, nudge_y = 0, 
                               xlim = c(NA, NA), ylim = c(NA, NA), na.rm = FALSE, show.legend = NA, 
                               direction = c("both", "y", "x"), seed = NA, 
                               inherit.aes = TRUE) {
  if (!missing(nudge_x) || !missing(nudge_y)) {
    if (!missing(position)) {
      stop("Specify either `position` or `nudge_x`/`nudge_y`", 
           call. = FALSE)
    }
  }
  layer(data = data, mapping = mapping, stat = stat, geom = GeomLabelRepel2, # change geom
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(parse = parse, box.padding = ggrepel:::to_unit(box.padding), 
                      label.padding = ggrepel:::to_unit(label.padding), point.padding = ggrepel:::to_unit(point.padding), 
                      label.r = ggrepel:::to_unit(label.r), label.size = label.size, 
                      segment.colour = segment.color %||% segment.colour, 
                      segment.size = segment.size, segment.alpha = segment.alpha, 
                      min.segment.length = ggrepel:::to_unit(min.segment.length), 
                      arrow = arrow, arrow.fill = arrow.fill, # add arrow.fill parameter
                      na.rm = na.rm, force = force, max.iter = max.iter, 
                      nudge_x = nudge_x, nudge_y = nudge_y, xlim = xlim, 
                      ylim = ylim, direction = match.arg(direction), seed = seed, 
                      ...))
}