这是@tjebo 提出的基本相同hack 的快速实现，其中两个grob-creation 步骤内部化在底层ggproto对象中。
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而不是中创建 grob draw_panel，以便按顺序绘制每条线的边框 grob 和链接 grob。
引入了两个新参数：
border_width：默认为 0；可以映射到数字美学。
border_colour：默认为“黑色”；可以更改为另一种颜色，但不打算在图层内改变，因为我认为这会使事情变得过于混乱。
注意：没有检查border_color，所以如果您使用该功能，请使用英式拼写，或自行修改该功能。=P
