How to add edges/borders to geom_link2 ? - follow up question

user_7570187 0
Viewed 144

This is a follow up from How to add edges/borders to the links in geom_link2 in R? where I wanted to know if there is a way to add an edge/border (not sure of the proper word) to the links created using ggforce::geom_link2? Something similar to points with pch >20.

A solution given by @tjebo was to make 2 geom_link/path layers, with the first one a bit wider than the second one to have it look like a border (see code below).

So I have 2 issues here:

  1. The edge is not apparent when there is a crossing. That can be rather messy in the case of an ordination with many points. Any solution?

  2. Why are my sizes not being respected? The black border link should constantly be 1 wider than the colourful link (ie 0.5 on each side). That is not the case here. Am I missing something?

library(ggforce)
#> Loading required package: ggplot2

df <- data.frame(x = c(5, 10, 5, 10), 
                 y = c(5, 10, 10, 5), 
                 width = c(1, 10, 6, 2), 
                 colour = letters[1:4], 
                 group = c(1, 1, 2, 2), 
                 width_border = c(2, 11, 7, 3))

ggplot(df) +
  geom_link2(aes(x = x, y = y,  group = group, size = width_border),
             lineend = 'round') +
  geom_link2(aes(x = x, y = y, colour = colour, group = group, size = width), 
             lineend = 'round', n = 500)

Created on 2021-02-13 by the reprex package (v1.0.0)

ggforce ggplot2 r
2 Answers

This is a semi-satisfactory workaround for your first problem. I am using ggplot's list character - each object/layer actually can be added as an actual list (instead of adding with +). Thus you can loop through the groups, plotting only the layers in the right order (first the background, then the foreground), and this will overlap correctly. This might be super slow in a plot with many many groups - on the other hand, in this case I would not be so sure if the chosen visualisation might be the best choice.

The second problem is likely caused by different scales applied to both your widths. A solution is to set a mutual scale, e.g., by adding scale_size_identity.

library(tidyverse)
library(ggforce)
df <- data.frame( x = c(5, 10, 5, 10), y = c(5, 10, 10, 5), width = c(1, 10, 6, 2), colour = letters[1:4], group = c(1, 1, 2, 2), width_border = c(2, 11, 7, 3))

ggplot(df) +
  scale_size_identity()+
  df %>% 
  split(., .$group) %>%
  map(., ~list(l1 = geom_link2(data = ., aes(x = x, y = y,  group = group, size = width_border), lineend = 'round'),
               l2 = geom_link2(data = ., aes(x = x, y = y, colour = colour, group = group, size = width), lineend = 'round', n = 500))
  )

Created on 2021-02-14 by the reprex package (v1.0.0)

P.S. I was very curious about a geom implementation - see Z.Lin's amazing answer. Thanks Z.Lin!

user_79411880

Here's a quick implementation of essentially the same hack proposed by @tjebo, with the two-grob-creation step internalised within the underlying ggproto object.

ggplot(df, aes(x = x, y = y, group = group)) +
  geom_link3(aes(colour = colour, size = width,
                 border_width = width_border),
             lineend = 'round', n = 500) +
  scale_size_identity() + ggtitle("1")

# border colour defaults to black, but can be changed to other colours as well
ggplot(df, aes(x = x, y = y, group = group)) +
  geom_link3(aes(colour = colour, size = width,
                 border_width = width_border),
             border_colour = "blue",
             lineend = 'round', n = 500) +
  scale_size_identity() + ggtitle("2")

# behaves just like geom_link2 if border_width / colour are not specified
ggplot(df, aes(x = x, y = y, group = group)) +
  geom_link3(aes(colour = colour, size = width),
             lineend = 'round', n = 500) +
  scale_size_identity() + ggtitle("3")

# also works with constant link colour/size & visibly varying border width 
ggplot(df, aes(x = x, y = y, group = group)) +
  geom_link3(aes(border_width = width_border*2),
             colour = "white", size = 2, 
             lineend = 'round', n = 500) +
  scale_size_identity() + ggtitle("4")

plots

(legends removed to conserve space)

Code:

GeomPathInterpolate3 <- ggproto(
  "GeomPathInterpolate3",
  ggforce:::GeomPathInterpolate,
  default_aes = aes(colour = "black",
                    size = 0.5,
                    linetype = 1,
                    alpha = NA,
                    border_colour = "black",
                    border_width = 0),
  draw_panel = environment(Geom$draw_panel)$f,
  draw_group = function (data, panel_scales, coord, arrow = NULL, 
                         lineend = "butt", linejoin = "round", linemitre = 1, 
                         na.rm = FALSE)   {
    if (!anyDuplicated(data$group)) {
      message("geom_path_interpolate: Each group consists of only one observation. ", 
              "Do you need to adjust the group aesthetic?")
    }
    data <- data[order(data$group), , drop = FALSE]
    data <- interpolateDataFrame(data)
    munched <- coord_munch(coord, data, panel_scales)
    rows <- stats::ave(seq_len(nrow(munched)), 
                       munched$group, FUN = length)
    munched <- munched[rows >= 2, ]
    if (nrow(munched) < 2) {
      return(zeroGrob())
    }
    attr <- ggplot2:::dapply(data, "group", function(df) {
      ggplot2:::new_data_frame(list(solid = identical(unique(df$linetype), 1), 
                          constant = nrow(unique(df[, 
                                                    c("alpha", "colour", 
                                                      "size", "linetype",
                                                      "border_width")])) == 1))
    })
    solid_lines <- all(attr$solid)
    constant <- all(attr$constant)
    if (!solid_lines && !constant) {
      stop("geom_path_interpolate: If you are using dotted or dashed lines", 
           ", colour, size and linetype must be constant over the line", 
           call. = FALSE)
    }
    n <- nrow(munched)
    group_diff <- munched$group[-1] != munched$group[-n]
    start <- c(TRUE, group_diff)
    end <- c(group_diff, TRUE)
    if (!constant) {
      ggplot2:::ggname("geom_link_border",
                       grid::grobTree(grid::segmentsGrob(munched$x[!end], munched$y[!end], munched$x[!start],
                                                         munched$y[!start], default.units = "native", arrow = arrow,
                                                         gp = grid::gpar(col = munched$border_colour[!end],
                                                                         fill = munched$border_colour[!end],
                                                                         lwd = munched$border_width[!end] * .pt,
                                                                         lty = munched$linetype[!end],
                                                                         lineend = lineend, linejoin = linejoin, linemitre = linemitre)),
                                      grid::segmentsGrob(munched$x[!end], munched$y[!end], munched$x[!start],
                                                         munched$y[!start], default.units = "native", arrow = arrow,
                                                         gp = grid::gpar(col = alpha(munched$colour, munched$alpha)[!end],
                                                                         fill = alpha(munched$colour, munched$alpha)[!end],
                                                                         lwd = munched$size[!end] * .pt,
                                                                         lty = munched$linetype[!end],
                                                                         lineend = lineend, linejoin = linejoin, linemitre = linemitre))))
    }
    else {
      ggplot2:::ggname("geom_link_border",
                       grid::grobTree(grid::polylineGrob(munched$x, munched$y, default.units = "native", 
                                                         arrow = arrow, 
                                                         gp = grid::gpar(col = munched$border_colour[!end],
                                                                         fill = munched$border_colour[!end], 
                                                                         lwd = munched$border_width[start] * .pt, 
                                                                         lty = munched$linetype[start], lineend = lineend, 
                                                                         linejoin = linejoin, linemitre = linemitre)),
                                      grid::polylineGrob(munched$x, munched$y, default.units = "native", 
                                                         arrow = arrow, 
                                                         gp = grid::gpar(col = alpha(munched$colour, munched$alpha)[start],
                                                                         fill = alpha(munched$colour, munched$alpha)[start], 
                                                                         lwd = munched$size[start] * .pt, 
                                                                         lty = munched$linetype[start], lineend = lineend, 
                                                                         linejoin = linejoin, linemitre = linemitre))))
      
    }
  }
)

geom_link3 <- function (mapping = NULL, data = NULL, stat = "link2", 
                        position = "identity", arrow = NULL, lineend = "butt", 
                        na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, 
                        ...) {
  layer(data = data, mapping = mapping, stat = stat, geom = GeomPathInterpolate3, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(arrow = arrow, lineend = lineend, na.rm = na.rm, 
                      n = n, ...))
}

The basic idea is to create the grobs in draw_group rather than draw_panel, so that each line's border grob & link grob are drawn sequentially.

Two new parameters are introduced:

  1. border_width: defaults to 0; can be mapped to a numerical aesthetic.

  2. border_colour: defaults to "black"; can be changed to another colour, but is not intended to vary within the layer, as I think that will make things too confusing.

Note: there's no checking for border_color, so if you are using the function, please use British spelling, or modify the function yourself. =P

user_84496290
Related