ความงามของอัลฟ่าแสดงให้เห็นโครงกระดูกของลูกศรแทนที่จะเป็นรูปร่างธรรมดา - จะป้องกันได้อย่างไร?

ฉันกำลังตั้งเป้าที่จะสร้างบาร์ที่มีลูกศรที่ท้ายบาร์ ฉันไป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 ใหม่geom_arrowbarเพื่อให้เราสามารถใช้เหมือน geom อื่น ๆ ดังนั้นในกรณีของคุณมันจะให้พล็อตที่ต้องการโดยเพียงแค่ทำ:

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ในลักษณะเดียวกับที่กำหนด geoms อื่นยกเว้นว่าเราต้องการให้สามารถส่งผ่านพารามิเตอร์ 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))