Альфа-естетик показує кістяк стрілки замість простої форми - як це запобігти?

Я націлений на побудову барної ділянки зі стрілками в кінці брусків. Я пішов geom_segmentз arrowвизначеним. Я хочу відобразити один стовпець на прозорість, але альфа-естетика, здається, не справляється із об’єктом стрілки. Ось фрагмент коду:

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_arrowbarякий ми можемо використовувати, як і будь-який інший гем, тож у вашому випадку він дасть бажаний сюжет, просто зробивши:

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

Тепер "все", що залишається, - це визначити, що GeomArrowBarтаке. Це фактично ggprotoвизначення класу. Найважливішою її частиною є draw_panelфункція-член, яка приймає кожен рядок нашого фрейму даних і перетворює його у форми стрілок. Після деяких базових математичних задач, які виходять з координат x і y, а також наших різних параметрів форми, якою має бути форма стрілки, вона створює по одному grid::polygonGrobдля кожного рядка наших даних і зберігає їх у 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, і це дасть неестетичні результати, якщо головки стрілок будуть довші, ніж цілий стовпець (хоча ви, можливо, не хочете використовувати такий сюжет у цій ситуації) . Однак стрілка ліворуч буде вказувати ліворуч, якщо у вас є негативне значення. Краща реалізація може також додати варіант для порожніх головок стрілок.

Коротше кажучи, знадобиться багато налаштувань, щоб виправити ці (та інші) помилки та зробити їх готовими до виробництва, але це досить добре, щоб тим часом створити кілька приємних діаграм, не заважаючи занадто багато зусиль.

^{Створено 2020-03-08 пакетом reprex (v0.3.0)}

Ви можете використовувати 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))