如何将 edges/borders 添加到 geom_link2 ？ - 跟进问题
How to add edges/borders to geom_link2 ? - follow up question
这是来自
我想知道是否有办法将 edge/border（不确定正确的词）添加到使用 ggforce::geom_link2 创建的 link？类似于 pch >20 的点。
@tjebo 给出的解决方案是制作 2 geom_link/path 层，第一层比第二层宽一点，让它看起来像一个边框（见下面的代码）。
所以我这里有 2 个问题：
有交叉时边缘不明显。在有很多点的排序的情况下，这可能会相当混乱。有什么解决办法吗？
为什么我的尺码没有得到尊重？黑色边框 link 应该始终比彩色边框 link 宽 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 (v1.0.0)
于 2021-02-13 创建
对于您的第一个问题，这是一个半令人满意的解决方法。我正在使用 ggplot 的列表字符 - 每个 object/layer 实际上都可以添加为实际列表（而不是添加 +）。因此，您可以循环遍历组，仅按正确顺序绘制图层（首先是背景，然后是前景），这将正确重叠。这在有很多组的情节中可能会非常慢 - 另一方面，在这种情况下，我不确定所选的可视化是否是最佳选择。
第二个问题可能是由于对两个宽度应用了不同的比例造成的。一种解决方案是设置相互比例，例如，通过添加 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))
)
由 reprex package (v1.0.0)
于 2021-02-14 创建
P.S。我对 geom 的实现很好奇 - 请参阅 Z.Lin 的惊人答案。谢谢Z.Lin！
这是 @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")
（为保护而删除的图例 space）
代码：
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，这样每条线的边框 grob 和 link grob 都是按顺序绘制的。
引入了两个新参数：
border_width：默认为0；可以映射到数字美学。
border_colour：默认为“黑色”；可以更改为另一种颜色，但不打算在层内变化，因为我认为这会使事情变得太混乱。
注意：border_color没有校验，所以如果您使用该函数，请使用英式拼写，或自行修改函数。 =P
这是来自
ggforce::geom_link2 创建的 link？类似于 pch >20 的点。
@tjebo 给出的解决方案是制作 2 geom_link/path 层，第一层比第二层宽一点，让它看起来像一个边框（见下面的代码）。
所以我这里有 2 个问题：
有交叉时边缘不明显。在有很多点的排序的情况下，这可能会相当混乱。有什么解决办法吗？
为什么我的尺码没有得到尊重？黑色边框 link 应该始终比彩色边框 link 宽 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 (v1.0.0)
于 2021-02-13 创建对于您的第一个问题，这是一个半令人满意的解决方法。我正在使用 ggplot 的列表字符 - 每个 object/layer 实际上都可以添加为实际列表（而不是添加 +）。因此，您可以循环遍历组，仅按正确顺序绘制图层（首先是背景，然后是前景），这将正确重叠。这在有很多组的情节中可能会非常慢 - 另一方面，在这种情况下，我不确定所选的可视化是否是最佳选择。
第二个问题可能是由于对两个宽度应用了不同的比例造成的。一种解决方案是设置相互比例，例如，通过添加 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))
)
由 reprex package (v1.0.0)
于 2021-02-14 创建P.S。我对 geom 的实现很好奇 - 请参阅 Z.Lin 的惊人答案。谢谢Z.Lin！
这是 @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")
（为保护而删除的图例 space）
代码：
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，这样每条线的边框 grob 和 link grob 都是按顺序绘制的。
引入了两个新参数：
border_width：默认为0；可以映射到数字美学。border_colour：默认为“黑色”；可以更改为另一种颜色，但不打算在层内变化，因为我认为这会使事情变得太混乱。
注意：border_color没有校验，所以如果您使用该函数，请使用英式拼写，或自行修改函数。 =P