A estética alfa mostra o esqueleto da flecha em vez da forma simples - como evitá-lo?

Meu objetivo é construir um gráfico de barras com flechas no final das barras. Eu fui geom_segmentcom arrowdefinido. Quero mapear uma coluna para a transparência, mas a estética alfa não parece funcionar bem com o objeto de seta. Aqui está o trecho 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))

Pode-se observar facilmente que o arrowobjeto não parece bem com valores mais baixos de alpha, mostrando seu esqueleto em vez de uma forma simples e transparente. Existe uma maneira de evitá-lo?

Podemos criar um novo geom, geom_arrowbarque podemos usar como qualquer outro geom; portanto, no seu caso, ele forneceria o gráfico desejado apenas fazendo:

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

E contém 3 parâmetros, column_width, head_widthe head_lengthque lhe permitem alterar a forma da seta se você não faz como os padrões. Também podemos especificar a cor do preenchimento e outras estéticas, conforme necessário:

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

O único problema é que temos que escrevê-lo primeiro!

Seguindo os exemplos da vinheta ggplot2 , podemos definir nossa geom_arrowbarda mesma maneira que outros geoms são definidos, exceto que queremos poder passar nossos três parâmetros que controlam a forma da seta. Eles são adicionados à paramslista do layerobjeto resultante , que será usado para criar nossa camada de setas:

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

Agora, "tudo" que resta é definir o que GeomArrowBaré. Esta é efetivamente uma ggprotodefinição de classe. A parte mais importante é a draw_panelfunção de membro, que pega cada linha do nosso quadro de dados e a converte em formas de seta. Após algumas matemáticas básicas para trabalhar a partir das coordenadas xey, bem como nossos vários parâmetros de forma, qual deve ser a forma da seta, ela produz uma grid::polygonGrobpara cada linha de nossos dados e a armazena em a gTree. Isso forma o componente gráfico da camada.

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 implementação está longe de ser perfeita. Faltam algumas funcionalidades importantes, como limites de eixo padrão sensíveis e a capacidade de coord_flip, e produzirá resultados não estéticos se as pontas das setas forem mais longas que a coluna inteira (embora você não queira usar esse gráfico nessa situação) . No entanto, sensivelmente, a seta estará apontando para a esquerda se você tiver um valor negativo. Uma implementação melhor também pode adicionar uma opção para pontas de setas vazias.

Em resumo, seriam necessários muitos ajustes para resolver esses (e outros) bugs e torná-los prontos para produção, mas é bom o suficiente para produzir alguns gráficos agradáveis ​​sem muito esforço nesse meio tempo.

^{Criado em 2020-03-08 pelo pacote reprex (v0.3.0)}

Você poderia usar geom_gene_arrowdelibrary(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))