Add an arrow with filled head to ggplot by geom_label_repel

Question

I want to add an arrow with a filled head to a ggplot object by using the geom_label_repel function. I thought that I could use: arrow.fill = 'black' like I do with the geom_segment, but it does not work in the geom_label_repel. Is it another way to get a filled arrow?

The reason why I use the geom_label_repel is that it was the only way I managed to start the arrow at the border of the label. If this coordinate can be found in another way, I could use the geom_segment instead.

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

We can see from GeomSegment$draw_panel that the arrow.fill value in geom_segment is passed to the fill parameter in grid::segmentsGrob. The same modification can be applied to 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')

Code for modified ggproto object & geom function:

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, 
                      ...))
}

Answer 2

While I would definitely go for the solution of Z.Lin, I just want to add a hack, which I usually apply, when I am not satisfied with the output of ggplot and I am too lazy to fix ggprotos (which are nightmarish to work with if you work with them only every now and then).

To make a long story short, here's my usual approach:

1. Convert the ggplot object to a grob.
2. Find the corresponding grob which I want to change.
3. Change it.
4. Use grid.draw to plot the whole object with the modified grob.

In our case this would look like this (N.B. I increased the distance to the label to be able to see the arrow in the first place):

library(tidyverse)
library(ggrepel)
library(grid)

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

gp <- ggplot(data = iris, aes(x=Sepal.Width, y=Sepal.Length)) +
  geom_point() +
  geom_label_repel(data=dmax, aes(label = 'max'), 
                   box.padding = unit(2, 'lines'), 
                   point.padding = unit(1.5, 'lines'), 
                   arrow = arrow(length = unit(0.5, 'cm'), type = 'closed'))

### 1. Convert to grob
ggp <- ggplotGrob(gp)

### 2. Find the `arrow` grob
## panel is the main plotting area of the ggplot
pan_idx <- grep("panel", ggp$layout[, "name"])
## the repel grob
repel_idx <- grep("repel", names(ggp$grobs[[pan_idx]]$children))

### 3. Change it, i.e. add a `gpar` with a fill
ggp$grobs[[pan_idx]]$children[[repel_idx]]$gp <- gpar(fill = "green")

### 4. Draw it
grid.draw(ggp)

---

Why I'd go with Z.Lin's proposal

As you can see, this approach relies heavily on some assumptions:

1. The structure of ggplotGrob. As this is an internal representation, we do not have any guarantee that this stays stable with future changes to ggplot2.
2. The structure is highly dependent on the plot you draw. Add some facets and it will require again a lot of skimming through the structure of the grobs to find the relevant one.
3. We rely on the fact that the repel grob's name contains the string "repel". This is again some internal convention, which may change over time and is thus not reliable on the long turn.

Bottom line is: this approach works nicely for a lot of quick fixes in case we need to change the appearance of a plot, but is by no means stable and always needs some manual browsing through the internal grob representation, which makes the solution fragile. However, I just wanted ot add it here as a maybe useful addition to your toolbox.