阿尔法美学显示箭头的骨架而不是简单的形状 - 如何防止?

13

我想要制作一张带有箭头的条形图。我使用了geom_segment和定义好的arrow。我想将其中一列映射到透明度上,但是alpha参数似乎与箭头对象不兼容。以下是代码片段:

tibble(y = c(10, 20, 30), n = c(300, 100, 200), transparency = c(10, 2, 4)) %>% 
  ggplot() + geom_segment(aes(x = 0, xend = n, y = y, yend = y, alpha = transparency), 
                          colour = 'red', size = 10, arrow = arrow(length = unit(1.5, 'cm'), type = 'closed')) +
  scale_y_continuous(limits = c(5, 35))

在此输入图片描述

很容易观察到,当alpha的值较低时,箭头对象看起来并不好看,呈现出其骨架而非纯粹透明的形状。有没有办法可以防止这种情况发生?


有趣的观察 - 我只能想到一些解决方法,比如绘制一个宽度较小的单独线段,例如:tibble(y = c(10, 20, 30), n = c(300, 100, 200), transparency = c(10, 2, 4)) %>% ggplot() + geom_segment(aes(x = 0, xend = n-10, y = y, yend = y, alpha = transparency), colour = 'red', size = 10) + geom_segment(aes(x = n-0.1, xend = n, y = y, yend = y, alpha = transparency), colour = 'red', size = 1, arrow = arrow(length = unit(1.5, 'cm'), type = 'closed')) + scale_y_continuous(limits = c(5, 35)) - Wolfgang Arnold
这确实很有趣。我想如果不计算重叠的“骨架”的确切面积,并为每个区域编程设置alpha,就无法避免这种情况(这将是一个可怕的hack)。如果你真的非常想要透明箭头,另一种方法是绘制1)线段和2)相邻的三角形。(对我来说,这也似乎是相当的hack)。 - tjebo
2
你肯定是对的,拥有箭头的平面透明度会很好。我相信这不是 ggplot 的任何行为引起的,而似乎与 'grid' 包绘制箭头的方式有关(ggplot2 依赖于此)。 - teunbrand
2个回答

20

我们可以创建一个新的几何对象geom_arrowbar,像使用其他几何对象一样使用它。因此,在您的情况下,只需执行以下操作即可获得所需的图形:

tibble(y = c(10, 20, 30), n = c(300, 100, 200), transparency = c(10, 2, 4)) %>%
  ggplot() +
  geom_arrowbar(aes(x = n, y = y, alpha = transparency), fill = "red") +
  scale_y_continuous(limits = c(5, 35)) +
  scale_x_continuous(limits = c(0, 350))

它包含3个参数,column_widthhead_widthhead_length,如果您不喜欢默认形状的箭头,可以通过这些参数进行更改。我们也可以根据需要指定填充颜色和其他美学效果:

enter image description here

tibble(y = c(10, 20, 30), n = c(300, 100, 200), transparency = c(10, 2, 4)) %>%
  ggplot() +
  geom_arrowbar(aes(x = n, y = y, alpha = transparency, fill = as.factor(n)),
                column_width = 1.8, head_width = 1.8, colour = "black") +
  scale_y_continuous(limits = c(5, 35)) +
  scale_x_continuous(limits = c(0, 350))

图片描述

唯一的问题是我们得先编写它!

按照 ggplot2 扩展文档 中的示例,我们可以定义自己的 geom_arrowbar,方法就像定义其他图形一样,只不过我们希望能够传入三个控制箭头形状的参数。这些参数添加到结果 layer 对象的 params 列表中,将用于创建我们的箭头层:

library(tidyverse)

geom_arrowbar <- function(mapping = NULL, data = NULL, stat = "identity",
                          position = "identity", na.rm = FALSE, show.legend = NA,
                          inherit.aes = TRUE, head_width = 1, column_width = 1,
                          head_length = 1, ...) 
{
  layer(geom = GeomArrowBar, mapping = mapping, data = data, stat = stat,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, head_width = head_width,
                      column_width = column_width, head_length = head_length, ...))
}

现在,“所有”的任务就是定义一个GeomArrowBar是什么。这实际上是一个ggproto类定义。最重要的部分是draw_panel成员函数,它会将我们数据框中的每一行转换为箭头形状。通过一些基本的数学计算,从x和y坐标以及各种形状参数中确定箭头的形状,它为我们数据的每一行生成一个grid::polygonGrob并将其存储在gTree中。这构成了该层的图形组件。

GeomArrowBar <- ggproto("GeomArrowBar", Geom,
  required_aes = c("x", "y"),
  default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = 1),
  extra_params = c("na.rm", "head_width", "column_width", "head_length"),
  draw_key = draw_key_polygon,
  draw_panel = function(data, panel_params, coord, head_width = 1,
                        column_width = 1, head_length = 1) {
    hwidth <- head_width / 5
    wid <- column_width / 10
    len <- head_length / 10
    data2 <- data
    data2$x[1] <- data2$y[1] <- 0
    zero <- coord$transform(data2, panel_params)$x[1]
    coords <- coord$transform(data, panel_params)
    make_arrow_y <- function(y, wid, hwidth) {
      c(y - wid/2, y - wid/2, y - hwidth/2, y, y + hwidth/2, y + wid/2, y + wid/2)
    }
    make_arrow_x <- function(x, len){
      if(x < zero) len <- -len
      return(c(zero, x - len, x - len , x, x - len, x - len, zero))
    }
    my_tree <- grid::gTree()
    for(i in seq(nrow(coords))){
      my_tree <- grid::addGrob(my_tree, grid::polygonGrob(
        make_arrow_x(coords$x[i], len),
        make_arrow_y(coords$y[i], wid, hwidth),
        default.units = "native",
        gp = grid::gpar(
          col = coords$colour[i],
          fill = scales::alpha(coords$fill[i], coords$alpha[i]),
          lwd = coords$size[i] * .pt,
          lty = coords$linetype[i]))) }
    my_tree}
)

这个实现远非完美。它缺少一些重要的功能,例如明智的默认轴限制和coord_flip的能力。如果箭头长度超过整个列,它将产生不美观的结果(虽然在那种情况下可能不想使用这样的图)。但是,如果您有一个负值,它会明智地指向左边。更好的实现可能还会添加空箭头选项。

简而言之,为了消除这些(和其他)错误并使其达到生产就绪状态,需要进行大量微调,但在此期间,它已经足够好以不费太多精力生成一些漂亮的图表。

reprex包(v0.3.0)于2020-03-08创建


这几乎是完美的。我正在尝试制作垂直指向箭头(从x轴到(x,y)点),我尝试使用coord_flip()进行解决,但没有成功。可能我只需要在您的代码中某个地方切换x和y,但是尝试这样做时我完全搞砸了。你能帮我吗? - Birte
@Birte,评论并不是获取帮助的最佳途径。也许您可以发布一个新问题,并附上您的数据?或者以下解决方案可能会有所帮助? - Allan Cameron
很不幸, Warning in install.packages : package ?ggenes? is not available (for R version 3.4.4) 提出一个新问题感觉有些多余。 - Birte

7

你可以使用来自 library(gggenes)geom_gene_arrow

data.frame(y=c(10, 20, 30), n=c(300, 100, 200), transparency=c(10, 2, 4)) %>% 
  ggplot() + 
  geom_gene_arrow(aes(xmin = 0, xmax = n, y = y, alpha = transparency), 
                  arrowhead_height = unit(6, "mm"), fill='red') +
  scale_y_continuous(limits = c(5, 35))

enter image description here


3
这一定是我刚刚重新发明的轮子! ;) - Allan Cameron

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接