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

`ggrepel::geom_label_repel`'s arrow parameter is provided by the `grid` package. There is no `arrow.fill` option in `grid::arrow`, so I don't think you can fill the arrow from `ggrepel::geom_label_repel`. — markhogue, Apr 06 '20 at 11:22
also geom_segment uses `arrow` from `grid`, yet it can fill the arrow head. You will probably have to dig into grob tables and whatnot. I'm trying to investigate how `geom_segment` does it — GGamba, Apr 06 '20 at 11:36
@GGamba may help your investigations. somehow related https://stackoverflow.com/questions/60446727/alpha-aesthetic-shows-arrows-skeleton-instead-of-plain-shape-how-to-prevent-i it seems to me that ggrepel must change the grid draw function how to draw an arrow - it seems that it does actually 'fill' the arrowhead... — tjebo, Apr 06 '20 at 17:56

score 4 · Answer 1 · answered Feb 15 '21 at 07:23

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

@Z.Lin do you have any tutorials how to make these complex functions? — PesKchan, Apr 15 '21 at 07:27

Add an arrow with filled head to ggplot by geom_label_repel

1 Answers1