如何向 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 层,第一个比第二个宽一点,让它看起来像一个边框(见下面的代码)。

所以我在这里有两个问题:

  1. 有交叉时边缘不明显。在有很多点的按立的情况下,这可能会相当混乱。有什么解决办法吗?

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

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

plots

(删除图例以节省空间)

代码:

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。

引入了两个新参数:

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

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

注意:没有检查border_color,因此如果您正在使用该函数,请使用英式拼写,或者自己修改该函数。 =P

相关问答

Selenium Web驱动程序和Java。元素在(x,y)点处不可单击。其...
Python-如何使用点“。” 访问字典成员?
Java 字符串是不可变的。到底是什么意思?
Java中的“ final”关键字如何工作?(我仍然可以修改对象。...
“loop:”在Java代码中。这是什么,为什么要编译?
java.lang.ClassNotFoundException:sun.jdbc.odbc.JdbcOdbc...