ggarchery 添加个性化箭头

Original JunJunLab 老俊俊的生信笔记 2023-06-15

收录于合集 #R包分享 168个

匆匆

1引言

今天分享一个 ggarchery R 包,用来添加箭头,达到不一样的效果。

github 地址:

https://github.com/cran/ggarchery

2安装

install.packages('ggarchery')

3使用

构造数据:

library(tidyverse)
library(ggarchery)

tbl <- tibble(x = c(0.1, 0.2), xend = c(0.1, 0.8), y = c(0.1, 0.5), yend = c(0.7, 0.9))

传统绘图:

ggplot(tbl) +
  geom_segment(aes(x = x, xend = xend, y = y, yend = yend), arrow = arrow()) +
  xlim(c(0,1)) +
  ylim(c(0,1))

geom_arrowsegment 函数添加箭头:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend)) +
  xlim(c(0,1)) +
  ylim(c(0,1))

调整箭头类型:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend), arrows = arrow(type = 'closed')) +
  xlim(c(0,1)) +
  ylim(c(0,1))

控制箭头位置:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend), arrow_positions = 0.5) +
  xlim(c(0,1)) +
  ylim(c(0,1))

调整箭头类型:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend), arrow_positions = 0.5, arrows = arrow(type = 'closed')) +
  xlim(c(0,1)) +
  ylim(c(0,1))

映射颜色:

tbl <- tbl %>% mutate(col = c("A", "B"))

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend, col = col), arrow_positions = 0.5)  +
  xlim(c(0,1)) +
  ylim(c(0,1))

添加箭头数量:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend), arrow_positions = c(0.25, 0.75))  +
  xlim(c(0,1)) +
  ylim(c(0,1))

设置 1 则为末端:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend), arrow_positions = c(0.25, 1))  +
  xlim(c(0,1)) +
  ylim(c(0,1))

调整不同角度,类型:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend), arrow_positions = c(0.25, 1), arrows = list(arrow(angle = 10), arrow(type = 'closed')))  +
  xlim(c(0,1)) +
  ylim(c(0,1))

添加箭头填充颜色:

ggplot(tbl) +
  geom_arrowsegment(aes(x = x, xend = xend, y = y, yend = yend),
                    arrow_positions = c(0.25, 1),
                    arrow_fills = c("indianred3", "dodgerblue3"),
                    arrows = arrow(type = "closed"))  +
  xlim(c(0,1)) +
  ylim(c(0,1))

作为注释:

ggplot(mtcars) +
  geom_point(aes(x = disp, y=hp)) +
  annotate(geom = "arrowsegment",
           x = 170,
           y=200,
           xend = 145,
           yend = 175,
           arrow_positions = 0.6,
           arrows = arrow(type = "closed", length = unit(0.1, "inches")))

4position_attractsegment 修整箭头

pt.tbl <- tibble(x = c(0.25, 0.5, 0.75), y = c(0.25, 0.5, 0.75), labels = c("A", "B", "C"))

ggplot(pt.tbl) +
  geom_point(aes(x,y, fill = labels), size =6, shape = 21) +
  geom_text(aes(x,y, label = labels)) +
  xlim(c(0, 1)) +
  ylim(c(0, 1)) +
  scale_fill_discrete(guide = "none")

添加箭头:

sg.tbl <- tibble(x = c(0.25, 0.5), y = c(0.25, 0.5), xend = c(0.5, 0.75), yend = c(0.5, 0.75))

ggplot(pt.tbl) +
  geom_point(aes(x,y, fill = labels), size =6, shape = 21) +
  geom_text(aes(x,y, label = labels)) +
  geom_segment(data = sg.tbl, aes(x = x, xend = xend, y = y, yend = yend), arrow = arrow()) +
  xlim(c(0, 1)) +
  ylim(c(0, 1)) +
  scale_fill_discrete(guide = "none")

修整:

ggplot(pt.tbl) +
  geom_point(aes(x,y, fill = labels), size =6, shape = 21) +
  geom_text(aes(x,y, label = labels)) +
  geom_segment(data = sg.tbl,
               aes(x = x, xend = xend, y = y, yend = yend),
               arrow = arrow(),
               position = position_attractsegment(start_shave = 0.1, end_shave = 0.1)) +
  xlim(c(0, 1)) +
  ylim(c(0, 1)) +
  scale_fill_discrete(guide = "none")

靠近点,减小间距:

ggplot(pt.tbl)+
  geom_segment(data = sg.tbl, aes(x = x, xend = xend, y = y, yend = yend), arrow = arrow(),
               position = position_attractsegment(start_shave = 0, end_shave = 0.05, type_shave = "distance")) +
  geom_point(aes(x,y, fill = labels), size =6, shape = 21) +
  geom_text(aes(x,y, label = labels))  +
  xlim(c(0, 1)) +
  ylim(c(0, 1)) +
  scale_fill_discrete(guide = "none") +
  coord_fixed()

建议 xy 范围一致 或者使用 coord_fixed() 函数。

组合使用:

ggplot(pt.tbl)+
  geom_arrowsegment(data = sg.tbl, aes(x = x, xend = xend, y = y, yend = yend),
                    arrow_positions = 0.6,
                    arrows = arrow(length = unit(0.1, "inches")),
                    position = position_attractsegment(start_shave = 0, end_shave = 0.05, type_shave = "distance")) +
  geom_point(aes(x,y, fill = labels), size =6, shape = 21) +
  geom_text(aes(x,y, label = labels))  +
  xlim(c(0, 1)) +
  ylim(c(0, 1)) +
  scale_fill_discrete(guide = "none") +
  coord_fixed()

5结尾

不足:

Current these replace only geom_segment() and work only for linear coordinate systems. I would like to extend to geom_curve() but the intricacies of grid::curveGrob() make that much more complicated. I am unsure if allowing these for the geom_line() and geom_path() parameterisations would be especially useful, but I'm happy to be told they would be.

欢迎加入生信交流群。加我微信我也拉你进微信群聊 老俊俊生信交流群 (微信交流群需收取20元入群费用(防止骗子和便于管理))。