Thẩm mỹ Alpha cho thấy bộ xương của mũi tên thay vì hình dạng đơn giản - làm thế nào để ngăn chặn nó?

Tôi đang nhắm đến việc xây dựng một âm mưu với các mũi tên ở cuối các thanh. Tôi đã đi geom_segmentvới arrowđịnh nghĩa. Tôi muốn ánh xạ một cột lên độ trong suốt, nhưng tính thẩm mỹ alpha dường như không hoạt động tốt với đối tượng mũi tên. Đây là đoạn mã:

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

Có thể dễ dàng quan sát thấy rằng arrowđối tượng không nhìn tốt với các giá trị thấp hơn alpha, hiển thị bộ xương của nó thay vì hình dạng trong suốt, đơn giản. Có cách nào để ngăn chặn nó?

Chúng ta có thể tạo một geom mới geom_arrowbar, mà chúng ta có thể sử dụng như bất kỳ geom nào khác, vì vậy trong trường hợp của bạn, nó sẽ đưa ra âm mưu mong muốn chỉ bằng cách thực hiện:

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

Và nó có chứa 3 thông số, column_width, head_widthvà head_lengthcho phép bạn thay đổi hình dạng của mũi tên nếu bạn không như giá trị mặc định. Chúng tôi cũng có thể chỉ định màu tô và tính thẩm mỹ khác khi cần:

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

Điều khó khăn duy nhất là chúng ta phải viết nó trước!

Theo các ví dụ trong họa tiết ggplot2 mở rộng , chúng ta có thể định nghĩa geom_arrowbartheo cùng cách mà các địa chất khác được xác định, ngoại trừ chúng ta muốn có thể truyền vào 3 tham số điều khiển hình dạng của mũi tên. Chúng được thêm vào paramsdanh sách layerđối tượng kết quả , sẽ được sử dụng để tạo lớp mũi tên của chúng ta:

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

Bây giờ "tất cả" còn lại là để xác định a GeomArrowBarlà gì . Đây thực sự là một ggprotođịnh nghĩa lớp. Phần quan trọng nhất của nó là draw_panelhàm thành viên, lấy từng dòng của khung dữ liệu của chúng ta và chuyển đổi nó thành hình dạng mũi tên. Sau khi một số phép toán cơ bản tìm ra tọa độ x và y cũng như các tham số hình dạng khác nhau của chúng ta, hình dạng của mũi tên sẽ là gì, nó tạo ra một grid::polygonGrobcho mỗi dòng dữ liệu của chúng ta và lưu trữ nó trong a gTree. Điều này tạo thành thành phần đồ họa của lớp.

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

Việc thực hiện này là xa hoàn hảo. Nó thiếu một số chức năng quan trọng, chẳng hạn như giới hạn trục mặc định hợp lý và khả năng coord_flip, và nó sẽ tạo ra kết quả thiếu thẩm mỹ nếu các đầu mũi tên dài hơn toàn bộ cột (mặc dù bạn có thể không muốn sử dụng một âm mưu như vậy trong tình huống đó) . Tuy nhiên, nó sẽ có mũi tên chỉ sang trái nếu bạn có giá trị âm. Việc triển khai tốt hơn cũng có thể thêm một tùy chọn cho các đầu mũi tên trống.

Nói tóm lại, nó sẽ cần rất nhiều điều chỉnh để khắc phục những lỗi này (và các lỗi khác) và làm cho nó sẵn sàng sản xuất, nhưng nó đủ tốt để tạo ra một số biểu đồ đẹp mà không cần quá nhiều nỗ lực trong thời gian đó.

^{Được tạo vào ngày 2020 / 03-08 bởi gói reprex (v0.3.0)}

Bạn có thể sử dụng geom_gene_arrowtừ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))