L'esthétique Alpha montre le squelette de la flèche au lieu de la forme simple - comment l'empêcher?

Je vise à construire un graphique à barres avec des flèches à la fin des barres. Je suis allé geom_segmentavec arrowdéfini. Je veux mapper une colonne sur la transparence, mais l'esthétique alpha ne semble pas fonctionner correctement avec l'objet flèche. Voici l'extrait de code:

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

Il peut être facilement observé que l' arrowobjet ne semble pas bien avec des valeurs inférieures de alpha, montrant son squelette au lieu d'une forme simple et transparente. Existe-t-il un moyen de l'empêcher?

Nous pouvons créer un nouveau géom, geom_arrowbarque nous pouvons utiliser comme n'importe quel autre géom, donc dans votre cas, cela donnerait l'intrigue souhaitée en faisant simplement:

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

Et il contient 3 paramètres column_width, head_widthet head_lengthqui vous permettent de modifier la forme de la flèche si vous ne le faites pas comme les valeurs par défaut. Nous pouvons également spécifier la couleur de remplissage et d'autres esthétiques selon les besoins:

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

Le seul hic, c'est qu'il faut d'abord l'écrire!

En suivant les exemples de la vignette ggplot2 étendue , nous pouvons définir notre geom_arrowbarde la même manière que les autres geoms sont définis, sauf que nous voulons pouvoir passer dans nos 3 paramètres qui contrôlent la forme de la flèche. Ceux-ci sont ajoutés à la paramsliste de l' layerobjet résultant , qui sera utilisé pour créer notre couche de flèches:

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

Il ne reste plus qu'à "définir" ce qu'est un GeomArrowBar. Il s'agit en fait d'une ggprotodéfinition de classe. La partie la plus importante est la draw_panelfonction membre, qui prend chaque ligne de notre trame de données et la convertit en forme de flèche. Après quelques calculs de base à partir des coordonnées x et y ainsi que de nos différents paramètres de forme quelle devrait être la forme de la flèche, il en produit un grid::polygonGrobpour chaque ligne de nos données et le stocke dans a gTree. Cela forme le composant graphique de la couche.

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

Cette implémentation est loin d'être parfaite. Il manque certaines fonctionnalités importantes, telles que des limites d'axe par défaut raisonnables et la possibilité de le faire coord_flip, et cela produira des résultats inesthétiques si les têtes de flèche sont plus longues que toute la colonne (bien que vous ne souhaitiez peut-être pas utiliser un tel tracé dans cette situation de toute façon) . Cependant, il y aura sensiblement la flèche pointant vers la gauche si vous avez une valeur négative. Une meilleure mise en œuvre pourrait également ajouter une option pour les têtes de flèche vides.

En bref, il faudrait beaucoup de réglages pour aplanir ces bogues (et d'autres) et le rendre prêt pour la production, mais c'est assez bon pour produire de beaux graphiques sans trop d'effort entre-temps.

^{Créé le 2020-03-08 par le package reprex (v0.3.0)}

Vous pouvez utiliser à geom_gene_arrowpartir delibrary(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))