Estetika alfa menunjukkan kerangka panah bukannya bentuk polos - bagaimana cara mencegahnya?

Saya bertujuan membangun plot bar dengan panah di ujung bar. Saya pergi geom_segmentdengan arrowdidefinisikan. Saya ingin memetakan satu kolom ke transparansi, tetapi estetika alfa tampaknya tidak berfungsi dengan baik dengan objek panah. Berikut cuplikan kode:

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

Dapat dengan mudah diamati bahwa arrowobjek tidak terlihat baik dengan nilai yang lebih rendah alpha, menunjukkan kerangkanya alih-alih bentuk polos, transparan. Apakah ada cara untuk mencegahnya?

Kita dapat membuat geom baru geom_arrowbar,, yang dapat kita gunakan seperti geom lainnya, jadi dalam kasus Anda itu akan memberikan plot yang diinginkan dengan hanya melakukan:

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

Dan berisi 3 parameter, column_width, head_widthdan head_lengthyang memungkinkan Anda untuk mengubah bentuk panah jika Anda tidak menyukai default. Kami juga dapat menentukan warna isi dan estetika lainnya sesuai kebutuhan:

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

Satu-satunya hambatan adalah kita harus menulisnya terlebih dahulu!

Dengan mengikuti contoh-contoh dalam sketsa ggplot2 yang diperluas , kita dapat mendefinisikan kita geom_arrowbardengan cara yang sama seperti geom lain yang didefinisikan, kecuali kita ingin dapat mengirimkan 3 parameter kita yang mengontrol bentuk panah. Ini ditambahkan ke paramsdaftar layerobjek yang dihasilkan , yang akan digunakan untuk membuat layer panah kami:

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

Sekarang "semua" yang tersisa adalah mendefinisikan apa GeomArrowBaritu. Ini adalah ggprotodefinisi kelas yang efektif . Bagian terpenting darinya adalah draw_panelfungsi anggota, yang mengambil setiap baris dataframe kami dan mengubahnya menjadi bentuk panah. Setelah beberapa matematika dasar untuk dikerjakan dari koordinat x dan y serta berbagai parameter bentuk kami seperti apa bentuk panah itu, ia menghasilkan satu grid::polygonGrobuntuk setiap baris data kami dan menyimpannya dalam a gTree. Ini membentuk komponen grafis dari layer.

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

Implementasi ini jauh dari sempurna. Ini kehilangan beberapa fungsi penting, seperti batas sumbu default yang masuk akal dan kemampuan untuk coord_flip, dan itu akan menghasilkan hasil yang tidak estetika jika kepala panah lebih panjang dari seluruh kolom (meskipun Anda mungkin tidak ingin menggunakan plot seperti itu dalam situasi itu) . Namun, akan ada panah yang menunjuk ke kiri jika Anda memiliki nilai negatif. Implementasi yang lebih baik mungkin juga menambahkan opsi untuk kepala panah kosong.

Singkatnya, perlu banyak penyesuaian untuk mengatasi bug (dan lainnya) ini dan membuatnya siap-produksi, tetapi cukup bagus untuk menghasilkan beberapa grafik yang bagus tanpa terlalu banyak upaya untuk sementara waktu.

^{Dibuat pada 2020-03-08 oleh paket reprex (v0.3.0)}

Anda dapat menggunakan geom_gene_arrowdarilibrary(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))