La estética alfa muestra el esqueleto de la flecha en lugar de la forma simple: ¿cómo prevenirlo?

Mi objetivo es construir un diagrama de barras con flechas al final de las barras. Fui por geom_segmentcon arrowdefinido. Quiero asignar una columna a la transparencia, pero la estética alfa no parece funcionar bien con el objeto de flecha. Aquí está el fragmento de código:

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

Se puede observar fácilmente que el arrowobjeto no se ve bien con valores más bajos de alpha, mostrando su esqueleto en lugar de una forma simple y transparente. ¿Hay una forma de prevenirlo?

Podemos crear una nueva geom, geom_arrowbarque podemos usar como cualquier otra geom, por lo que en su caso daría la trama deseada simplemente haciendo:

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

Y contiene 3 parámetros, column_width, head_widthy head_lengthque le permiten cambiar la forma de la flecha si no lo hace como los valores por defecto. También podemos especificar el color de relleno y otra estética según sea necesario:

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

¡El único inconveniente es que tenemos que escribirlo primero!

Siguiendo los ejemplos en la viñeta ggplot2 que se extiende , podemos definir nuestro geom_arrowbarde la misma manera que se definen otras geoms, excepto que queremos poder pasar nuestros 3 parámetros que controlan la forma de la flecha. Estos se agregan a la paramslista del layerobjeto resultante , que se utilizará para crear nuestra capa de flechas:

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

Ahora "todo" lo que queda es definir qué GeomArrowBares a. Esta es efectivamente una ggprotodefinición de clase. La parte más importante es la draw_panelfunción miembro, que toma cada línea de nuestro marco de datos y la convierte en formas de flecha. Después de algunas matemáticas básicas para resolver a partir de las coordenadas xey, así como nuestros diversos parámetros de forma, cuál debería ser la forma de la flecha, produce una grid::polygonGrobpara cada línea de nuestros datos y la almacena en a gTree. Esto forma el componente gráfico de la capa.

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

Esta implementación está lejos de ser perfecta. Le faltan algunas funciones importantes, como los límites de eje predeterminados razonables y la capacidad de hacerlo coord_flip, y producirá resultados poco estéticos si las puntas de flecha son más largas que la columna completa (aunque de todos modos es posible que no desee utilizar dicho diagrama en esa situación) . Sin embargo, sensiblemente tendrá la flecha apuntando hacia la izquierda si tiene un valor negativo. Una mejor implementación también podría agregar una opción para puntas de flecha vacías.

En resumen, necesitaría muchos ajustes para solucionar estos (y otros) errores y prepararlos para la producción, pero es lo suficientemente bueno como para producir algunos gráficos agradables sin demasiado esfuerzo mientras tanto.

^{Creado el 2020-03-08 por el paquete reprex (v0.3.0)}

Podrías usar geom_gene_arrowdesdelibrary(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))