L'estetica alfa mostra lo scheletro di una freccia anziché una forma semplice: come prevenirla?

Sto mirando a costruire un grafico a barre con le frecce alla fine delle barre. Sono andato geom_segmentcon arrowdefinito. Voglio mappare una colonna sulla trasparenza, ma l'estetica alfa non sembra funzionare bene con l'oggetto freccia. Ecco lo snippet di codice:

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

Si può facilmente osservare che l' arrowoggetto non ha un bell'aspetto con valori inferiori di alpha, mostrando il suo scheletro anziché una forma semplice e trasparente. C'è un modo per prevenirlo?

Possiamo creare un nuovo geom, geom_arrowbarche possiamo usare come qualsiasi altro geom, quindi nel tuo caso darebbe la trama desiderata semplicemente facendo:

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 contiene 3 parametri, column_width, head_widthe head_lengthche consentono di modificare la forma della freccia, se non lo fai come i valori di default. Possiamo anche specificare il colore di riempimento e altre estetiche secondo necessità:

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

L'unico inconveniente è che dobbiamo scriverlo prima!

Seguendo gli esempi nell'estensione della vignetta ggplot2 , possiamo definire i nostri geom_arrowbarnello stesso modo in cui sono definiti altri geomi, tranne che vogliamo essere in grado di passare i nostri 3 parametri che controllano la forma della freccia. Questi vengono aggiunti paramsall'elenco layerdell'oggetto risultante , che verrà utilizzato per creare il nostro livello di frecce:

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

Ora "tutto" ciò che resta è definire ciò che GeomArrowBarè. Questa è effettivamente una ggprotodefinizione di classe. La parte più importante di essa è la draw_panelfunzione membro, che prende ogni riga del nostro frame di dati e la converte in forme di freccia. Dopo alcuni calcoli matematici di base sulle coordinate xey, nonché sui nostri vari parametri di forma quale dovrebbe essere la forma della freccia, ne produce uno grid::polygonGrobper ogni riga dei nostri dati e lo memorizza in a gTree. Ciò costituisce il componente grafico del livello.

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

Questa implementazione è tutt'altro che perfetta. Manca alcune importanti funzionalità, come i limiti degli assi predefiniti sensibili e la possibilità dicoord_flip , e produrrà risultati antiestetici se le teste delle frecce sono più lunghe dell'intera colonna (anche se potresti non voler comunque utilizzare un tale diagramma in quella situazione) . Tuttavia, avrà ragionevolmente la freccia che punta a sinistra se si dispone di un valore negativo. Una migliore implementazione potrebbe anche aggiungere un'opzione per punte di freccia vuote.

In breve, occorrerebbero molte modifiche per appianare questi (e altri) bug e renderli pronti per la produzione, ma nel frattempo è abbastanza buono per produrre dei grafici carini senza troppi sforzi.

^{Creato il 2020-03-08 dal pacchetto reprex (v0.3.0)}

Puoi usare geom_gene_arrowdalibrary(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))