ggplot2绘制高端散点图

让我们用R中臭名昭著的鸢尾花数据来进行实际效果的展示各位看官老爷们请细细品味，喜欢的小伙伴可以关注个人公众号R语言数据分析指南，持续分享更多实用教程

绘制箭头的基础语法

geom_segment()在点(x,y)和(xend，yend)之间绘制一条直线
geom_curve画一条曲线

直线箭头

library(tidyverse)
ggplot(mtcars, aes(wt, mpg))+
  geom_point()+
  geom_segment(aes(x = 5,y = 30,xend = 3.5,yend = 25),
  arrow = arrow(length = unit(0.4,"cm")))

曲线箭头

df <- data.frame(x1 = 2.62, x2 = 3.57, y1 = 21.0, y2 = 15.0)

ggplot(mtcars, aes(wt, mpg)) +
  geom_point() + geom_curve(
  aes(x = x1, y = y1, xend = x2, yend = y2),
  data = df,size=1,color="red",angle = 90,
  arrow = arrow(length = unit(0.03, "npc"),type="closed"))

改变箭头方向

ggplot(mtcars,aes(wt, mpg)) +
  geom_point()+
  geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2),
  data = df,size=1,color="black",curvature = 1,
  arrow = arrow(length = unit(0.03,"npc"),ends="first"))

• curvature 曲线弯曲程度
• ends="first"改变箭头方向
• type="closed"对箭头进行填充

实际案例展示

自定义主题

rm(list=ls())
pacman::p_load(tidyverse,reshape2,ggsci)

theme_niwot <- function(){
  theme_bw() +
    theme(text = element_text(family = "Times"),
          axis.line.x = element_line(color="black"), 
          axis.line.y = element_line(color="black"),
          axis.text.x = element_text(family = "Times",size=12,face="plain"),
          axis.text.y = element_text(family = "Times",size=12,face="plain"),
          panel.border = element_blank(),
          axis.title.x = element_text(margin = margin(t = 10),size=13,
                                      family = "Times",color="black"),
          axis.title.y = element_text(margin = margin(r = 10),size=13,
                                      family = "Times",color="black"),
          panel.grid.major.x = element_blank(),                                          
          panel.grid.minor.x = element_blank(),
          panel.grid.minor.y = element_blank(),
          panel.grid.major.y = element_blank(),  
          plot.margin = unit(c(1, 1, 1, 1), units = ,"cm"),
          legend.text = element_text(size = 12,family ="Times"),          
          legend.title = element_blank(),                          
          legend.key = element_blank(),
          panel.background = element_rect(fill = "white"),
          legend.background = element_rect(color = "black", 
         fill = "transparent",size = 2, linetype = "blank"))
}

数据整合

iris_mean <- iris %>% melt() %>% 
  summarize(avg = mean(value,na.rm = T)) %>% pull(avg)

mean <- iris %>% melt() %>% 
  group_by(variable) %>% summarise(mean=mean(value)) %>%
  mutate(y1=iris_mean)

#pull 提取单列

可视化操作

iris %>% melt() %>% 
  ggplot(aes(variable,value))+
  geom_point(aes(color = Species), 
             position = position_jitter(width = 0.2),
             size =2,alpha = 0.5)+
  scale_color_npg()+theme_niwot()+
  theme(legend.position = "none")+
  geom_point(data=mean,aes(x=variable,y=mean),size=5,
             color=c("#E41A1C","#1E90FF","#FF8C00","#4DAF4A"))+
  geom_hline(aes(yintercept=iris_mean),
             color = "gray70",size = 1)+coord_flip()+
  geom_segment(data=mean,aes(x = variable, xend = variable,
                   y =y1,yend =mean),size=0.8,
               color=c("#E41A1C","#1E90FF","#FF8C00","#4DAF4A"))+
  annotate("text", x =4.3, y = 7, family = "Times",
    size = 4, color = "gray20",
    label = "The mean number of\niris observations was 3.46")+
  annotate("text", x = 3.8, y = 6, family = "Times",
    size = 4, color = "gray20",
    label ="The mean number of\nPetal.Length observations was 3.76")+
  annotate(
    "text", x = 1, y = 1.2,
    family = "Times", size =4, color = "gray20",
    label="The mean number of\nPetal.Length observations was 3.06")+
  geom_curve(aes(x =4.1,y = 7,yend =3.46,xend = 3.6),
             arrow = arrow(length = unit(0.03, "npc"),type="closed"),
             size = 0.5,curvature=0.2,
             color = "grey30")

可以通过创建数据框的方式添加曲线，在此就不一一展示了

参考：https://mp.weixin.qq.com/s/vR_wNHLrEnWG13wa0pcThA