简介
老板觉得课件的图形太过模糊和单调,于是想让我用可视化软件复现一下,做的更加高清、精美些。
当我本科的时候,对于这种问题,我第一时间想起来的就是使用 PPT 绘制啦~。但是自从学习了 R 语言、ggplot 语法之后,我果断使用 ggplot2 包来实现。大概花了 30min 左右复现这个图形。对比结果如下:
主要由两部分构成:1. 绘制密度函数曲线并填充分位数面积;2. 添加各种线段和文字。
数据产生
set.seed(1) #确保不同机子产生的随机数相同 mu = c(2,5) std = c(1,1) num = 1000 r1 = rnorm(num,mu[1],std[1]) #正态分布 r2 = rnorm(num,mu[2],std[2]) #正态分布 data = data.frame('value' = c(r1,rep(NA,num),r2,rep(NA,5*num)), 'class' = factor(rep(c(1:8),each= num))) knitr::kable(head(data))
定义主题
文中定义了一个自定义主题函数theme_manual()
,主要想把背景,各种刻度都去掉。大家以后有这个需求可以直接拿去用,当然最好不要白嫖,打个赏也行嘿嘿。
theme_manual = function(){ theme(panel.grid = element_blank(), panel.border = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(), legend.position="none") }
画图
ggplot(data, aes(x = value, y = class,fill = factor(stat(quantile)))) + # 添加密度函数图 stat_density_ridges( geom = "density_ridges_gradient", calc_ecdf = TRUE,rel_min_height = 0.02, quantiles = c(0.025, 0.975), alpha = 1,scale = 0.6,bandwidth = 1 ) + scale_fill_manual( name = "Probability", values = c("#FF0000A0", "white", "#FF0000A0"), labels = c("(0, 0.025]", "(0.025, 0.975]", "(0.975, 1]") ) + # 手动一条条添加各种线段,文字 annotate("segment", x = mu[1], xend = mu[1], y = 1, yend = 7,colour = "black") + annotate("segment", x = mu[2]-1, xend = mu[2]-1, y = 1, yend = 7,colour = "#0000FFA0",lty = "dashed") + annotate("segment", x = mu[1]-2.15, xend = mu[1]-2, y = 1, yend = 7,colour = "#0000FFA0",lty = "dashed") + annotate("segment", x = mu[2], xend = mu[2], y = 3-0.02, yend = 4.18,colour = "black") + annotate("segment", x = 0, xend = 10, y = 3, yend = 3,colour = "black") + annotate("segment", x = -3, xend = 7, y = 1, yend = 1,colour = "black") + annotate("text", x = mu[1], y = 0.7, label = expression(mu[T])) + annotate("text", x = mu[1]-2.15, y = 0.7, label = expression(alpha[1])) + annotate("text", x = mu[1]+2, y = 0.7, label = expression(alpha[2])) + annotate("text", x = mu[2], y = 2.8, label = expression(mu[T])) + annotate("text", x = 0.5, y = 3.9, label = expression(beta)) + annotate(geom = "line",x = c(0.8, 3.1), y = c(3.8, 3.2), arrow = arrow(angle = 20, length = unit(4, "mm"))) + # 添加线段并且包含箭头 annotate("text", x = mu[1], y = 7.3, label = "CL") + annotate("text", x = mu[2]-1, y = 7.4, label = "LCL") + annotate("text", x = mu[1]-2, y = 7.4, label = "UCL") + annotate("text", x = -1.3, y = 2.3, label = expression(alpha[1] + alpha[2] == alpha)) + coord_flip() + # 转换横纵坐标 theme_bw() + # 主题设置 theme_manual() + xlab('') + ylab('')
可以看到,现在得到的图形和原图还是有点出处的。
调整图形细节
笔者能力有限,不能复现的一模一样,于是我使用了 AI 大法,对该图形进行了细节修改(保存该图为 pdf 版本,使用 AI 打开,进行调节)。最后得到:
如何使用 AI 可以看这篇文章:画图细节不会改?那就用 AI 吧!;AI不会,没关系,R可以导出PPT格式的图形啦!