Alpha美学显示了箭头的骨架，而不是普通的形状-如何预防？

我的目标是在条形图的末端建立带有箭头的条形图。我去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))

可以很容易地观察到，arrow使用较低的值，对象看起来并不好alpha，显示出其骨架而不是普通的透明形状。有办法预防吗？

我们可以创建一个新的geom，geom_arrowbar我们可以像使用其他任何geom一样使用它，因此在您的情况下，只需执行以下操作即可提供所需的绘图：

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

唯一的困扰是我们必须先编写它！

按照扩展的ggplot2插图中的示例，我们可以用定义geom_arrowbar其他几何的相同方式来定义我们，只是我们希望能够传入控制箭头形状的3个参数。这些将添加到params结果layer对象的列表中，该列表将用于创建我们的箭头层：

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, ...))
}

现在，剩下的“全部”就是定义a GeomArrowBar是什么。这实际上是一个ggproto类定义。其中最重要的部分是draw_panel成员函数，该函数采用数据框的每一行并将其转换为箭头形状。在根据x和y坐标以及我们的各种形状参数算出一些基本的数学运算后，箭头的形状应该是箭头，它会grid::polygonGrob为我们的数据的每一行产生一个并将其存储在a中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}

你可以使用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))