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

Posted 2023-02-16

【中文标题】阿尔法美学显示箭头的骨架而不是简单的形状 - 如何防止它？

【英文标题】：Alpha aesthetic shows arrow's skeleton instead of plain shape - how to prevent it?

【发布时间】：2020-06-12 06:18:36

【问题描述】：

我的目标是在条形图的末端构建一个带有箭头的条形图。我去了geom_segment，并定义了arrow。我想将一列映射到透明度上，但 alpha 美学似乎不适用于箭头对象。这是sn-p的代码：

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

可以很容易地观察到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-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))

这确实很有趣。我想如果不计算重叠“骨架”的确切区域并以编程方式为每个区域设置 alpha（这将是一个可怕的黑客攻击），这是无法避免的。如果您真的想要透明箭头，另一种方法是绘制 1) 段和 2) 与其相邻的三角形。 （这对我来说似乎也是一个 hack）。

你肯定是对的，如果有一个平面透明的箭头会很好。我相信这不是由 ggplot 端的任何行为引起的，但似乎与“网格”包如何绘制箭头（ggplot2 依赖于该箭头）有关。

【参考方案1】：

您可以使用geom_gene_arrow 中的library(gggenes)

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

【讨论】：

这一定是我刚刚重新发明的***！ ;)

【参考方案2】：

我们可以创建一个新的几何图形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_width、head_width 和 head_length，如果您不喜欢默认设置，可以更改箭头的形状。我们还可以根据需要指定填充颜色和其他美学：

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

唯一的障碍是我们必须先写它！

按照extending ggplot2 vignette 中的示例，我们可以像定义其他几何图形一样定义我们的geom_arrowbar，除了我们希望能够传入控制箭头形状的3 个参数。这些被添加到生成的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 并将其存储在 @987654341 @。这形成了图层的图形组件。

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 package (v0.3.0) 于 2020-03-08 创建}

【讨论】：

这几乎是完美的。我正在尝试制作垂直指向的箭头。 （从 x 轴到 (x,y) 点，我尝试使用 coord_flip() 解决它，但它不起作用。可能我只需要在代码中的某个位置切换 x 和 y 尝试做所以我完全搞砸了。你能帮帮我吗？

@Birte cmets 并不是获得帮助的最佳场所。也许你可以用你的数据发布一个新问题？或者，下面的解决方案可能会有所帮助？

不幸的是` install.packages中的警告：包？ggenes？不可用（对于 R 版本 3.4.4）` 提出一个新问题对这个问题来说是多余的。