如何解决如何向 geom_link2 添加边/边框? - 跟进问题
这是来自
How to add edges/borders to the links in geom_link2 in R?
我想知道是否有办法为使用 ggforce::geom_link2
创建的链接添加边缘/边框(不确定正确的词)?类似于 pch >20 的点。
@tjebo 给出的解决方案是制作 2 个 geom_link/path 层,第一个比第二个宽一点,让它看起来像一个边框(见下面的代码)。
所以我在这里有两个问题:
library(ggforce)
#> Loading required package: ggplot2
df <- data.frame(x = c(5,10,5,10),y = c(5,5),width = c(1,6,2),colour = letters[1:4],group = c(1,1,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,colour = colour,size = width),lineend = 'round',n = 500)
由 reprex package (v1.0.0) 于 2021 年 2 月 13 日创建
解决方法
对于您的第一个问题,这是一种半满意的解决方法。我正在使用 ggplot 的列表字符 - 每个对象/图层实际上都可以作为实际列表添加(而不是使用 +
添加)。因此,您可以遍历组,仅以正确的顺序绘制图层(首先是背景,然后是前景),这将正确重叠。在包含许多组的图中,这可能会非常慢 - 另一方面,在这种情况下,我不太确定所选的可视化是否是最佳选择。
第二个问题可能是由应用于您的宽度的不同比例引起的。一种解决方案是设置相互规模,例如,通过添加 scale_size_identity
。
library(tidyverse)
library(ggforce)
df <- data.frame( x = c(5,10,5,10),y = c(5,5),width = c(1,6,2),colour = letters[1:4],group = c(1,1,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 = .,colour = colour,size = width),lineend = 'round',n = 500))
)
由 reprex package (v1.0.0) 于 2021 年 2 月 14 日创建
附言我对 geom 的实现很好奇 - 请参阅 Z.Lin 的惊人答案。谢谢Z.Lin!
,这里是@tjebo 提出的基本相同的 hack 的快速实现,在底层 ggproto
对象中内化了两个 grob-creation 步骤。
ggplot(df,group = group)) +
geom_link3(aes(colour = colour,size = width,border_width = width_border),n = 500) +
scale_size_identity() + ggtitle("1")
# border colour defaults to black,but can be changed to other colours as well
ggplot(df,border_colour = "blue",n = 500) +
scale_size_identity() + ggtitle("2")
# behaves just like geom_link2 if border_width / colour are not specified
ggplot(df,n = 500) +
scale_size_identity() + ggtitle("3")
# also works with constant link colour/size & visibly varying border width
ggplot(df,group = group)) +
geom_link3(aes(border_width = width_border*2),colour = "white",size = 2,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],gp = grid::gpar(col = alpha(munched$colour,munched$alpha)[!end],fill = alpha(munched$colour,lwd = munched$size[!end] * .pt,linemitre = linemitre))))
}
else {
ggplot2:::ggname("geom_link_border",grid::grobTree(grid::polylineGrob(munched$x,munched$y,lwd = munched$border_width[start] * .pt,lty = munched$linetype[start],grid::polylineGrob(munched$x,munched$alpha)[start],lwd = munched$size[start] * .pt,linemitre = linemitre))))
}
}
)
geom_link3 <- function (mapping = NULL,data = NULL,stat = "link2",position = "identity",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,na.rm = na.rm,n = n,...))
}
基本思想是在draw_group
而不是draw_panel
中创建grob,以便按顺序绘制每条线的边框grob和链接grob。
引入了两个新参数:
-
border_width
:默认为 0;可以映射到数字美学。 -
border_colour
:默认为“黑色”;可以更改为另一种颜色,但不打算在图层内变化,因为我认为这会使事情变得太混乱。
注意:没有检查border_color
,因此如果您正在使用该函数,请使用英式拼写,或者自己修改该函数。 =P
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。