r - 如何向 geom_link2 添加边缘/边框？ - 跟进问题

Question

这是跟进 How to add edges/borders to the links in geom_link2 in R?我想知道是否有办法向使用 ggforce::geom_link2 创建的链接添加边缘/边框(不确定正确的词)？类似于 pch >20 的点。

@tjebo 给出的解决方案是制作 2 个 geom_link/path 层，第一个比第二个宽一点，让它看起来像一个边框(见下面的代码)。

所以我这里有两个问题:

1. 有十字路口时边缘不明显。在有很多点的排序的情况下，这可能会相当困惑。有什么解决办法吗？

2. 为什么我的尺码没有得到遵守？黑色边框链接应始终比彩色链接宽 1(即每边 0.5)。这里情况不同。我错过了什么吗？

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)

^{由 reprex package 创建于 2021-02-13 (v1.0.0)}

Answer 1

下面是 @tjebo 提出的基本相同 hack 的快速实现，在底层 ggproto 对象中内化了两个 grob-creation 步骤。

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

(为节省空间删除了图例)

代码:

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

基本思想是在 draw_group 而不是 draw_panel 中创建 grob，这样每条线的 border grob 和 link grob 都是按顺序绘制的。

引入了两个新参数:

1. border_width:默认为0；可以映射到数字美学。

2. border_colour:默认为“黑色”；可以更改为另一种颜色，但不打算在层内变化，因为我认为这会使事情变得太困惑。

注意:没有检查border_color，所以如果您使用该函数，请使用英式拼写，或自行修改函数。 =P