R-南丁格尔玫瑰图: 仿制效果最好的疫情玫瑰图

54 阅读 0 评论 36 点赞

我是靠谱客的博主无奈路灯，最近开发中收集的这篇文章主要介绍R-南丁格尔玫瑰图: 仿制效果最好的疫情玫瑰图，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

这是到目前为止我觉得讲解最为细致、仿制与色彩改进效果最好的疫情玫瑰图教程。所以特约稿给大家学习！作者码字不易，还请多多支持。

Angus,温州医科大学在读博士，急诊医学专业，主攻临床数据库及人工智能在危重症患者的应用。

EasyShu-张杰

大家好，我是Angus，最近人民日报的NCP疫情图引起了很多科研工作者的兴趣，应EasyShu-杰哥邀请，我给大伙讲一下如何绘制疫情玫瑰图。首先看看2020年3月12日的图片，见下面。

接下来我就带大家解析这张图，我的制图习惯是出图前先画草图，这样便于图形制作时条理清晰。

设计解析

那么接下来看一下这张图的设计，如下。

从原型图中我们可以看到，这张图的底图是bar plot，在这基础上的其他元素包括：

???? 3种label，在这里，我们不做死亡的label，只做例数和国家的；

???? 2组同心圆，其实质就是bar plot。

在label部分，我们这里涉及3种类型：

???? 右下角：label在barplot外 + 旋转；

????左下角：label在bar plot内；

????左上角：label在bar plot外+ 旋转 + 文本换行。

OK，现在开始干活。打开你的RStudio。我们这里要用的是tidyverse组合包，我习惯每次直接用套件，而不是单独载入ggplot2包。组合包便于我们在制图过程中，对数据直接变形。如果没有安装的，请先安装该包。

1. 载入包

判断环境，并载入包，若未安装tidyverse，会自动进行安装。

if (!requireNamespace("tidyverse", quietly = TRUE)) {
  install.packages(tidyverse)
}
library(tidyverse)

2. 准备数据

这里我开始生成一批类似上图的数据。

其中：

???? id：对应每一个国家，这里共生成26个字母国家；

???? height：对应NCP疫情数目；

???? label：bar plot的标签。

那么label这部分，因为我们有3种类型，所以在mutate里我们分别进行操作：

???? 右半边：应该是×例×国，即id ∈ [1， 13]这部分；

???? 左下部：国家都在例数下面，所以它应该在例数和国家之间应该有个换行符，即id ∈ [14， 21]这部分；

???? 左上部：国家又跑到例数上面，所以我们在国家和例数之间添加换行符，即id ∈ [22， 26]这部分。

dat <-
  data.frame(id = 1:26,
             height = c(seq(100, 550, 20),
                        seq(650, 700, 20))) %>%
  mutate(
    label = case_when(
      id <= 13 ~ paste0(height, "例 ", LETTERS[id], "国"),
      id <= 21 ~ paste0(height, "例n", LETTERS[id], "国"),
      T ~ paste0(LETTERS[id], "国n", height, "例")
    )
  )

3.图表绘制

开始画底图 + 同心圆的bar plot

p1 <-
ggplot(data = dat, aes(x = id, y = height, label = label)) +
geom_col(aes(fill = id), width = 1, size = 0) +
geom_col(
aes(y = 40),
fill = "white",
width = 1,
alpha = 0.2,
size = 0
  ) +
geom_col(
aes(y = 20),
fill = "white",
width = 1,
alpha = 0.2,
size = 0
  )
p1

L7/14：我们将bar的宽度设为1，消除间隔。

L4-10：添加外部的同心圆bar plot，白色填充，同时设置alpha属性。

L11-17：添加内部的同心圆bar plot，同理操作，外部和内部的alpha设置一样大，这样一重叠，内部的实际显示就会变成0.4。

跑完后，我们就会看到下图。

这张图看起来是不是每条bar之间还有间隔线，来来来，我给你放大到2000倍。我们就会发现其实间隔线只是颜色的过渡引起的错觉。

OK，那么我们的底图就做好了，接下来就是极坐标变形了，同时添加中间的空心园。

同时，我们去掉一些没用的背景，坐标轴等元素，图例等改bar的颜色时再进行一起去除。极坐标变形后，2个圆环的效果就很明显了。

p2 <-
p1 +
coord_polar() +
theme_void() +
scale_y_continuous(limits = c(-60, 701))
p2

接下来，我们为每一条bar添加label。

p3 <-
p2 +
geom_text(
data = . %>% filter(id <= 13),
nudge_y = 80,
angle = 95 - 180 * c(1:13) / 13,
fontface = "bold"
) +
geom_text(
data = . %>% filter(between(id, 14, 21)),
nudge_y = -55,
nudge_x = -0.1,
color = "white",
fontface = "bold"
) +
geom_text(
data = . %>% filter(id >= 22),
nudge_y = -50,
color = "white",
angle = 80 - 75 * c(1:5)/5,
fontface = "bold"
)
p3

L4/10/17：动态筛选数据。

L5/11-12/18：通过nudge_*属性来调整3种label的相对位置，实现label分别位于外面和里面。

L6/20：设置angle来根据bar的位置来动态调整label的角度，以实现旋转。

L13/20：将内部的label设置为白色勾勒，增加文字的可读性，同时对所有的label，我们都对其加粗以达到图片的效果。

下面看看效果。

到p3这里，基本的轮廓就已经出来了，接下来就是去除legend，更改每条bar的颜色了。为什么要在这里才去除legend呢，这是因为我们一开始添加的legend是fill属性哦。

首先原图我们上下左右各取一点颜色，加上开头就是一共5个颜色，接着就是让这5个颜色产生渐变。

不同显示器拾色可能会有差异，我这里拾到的5个颜色分别为：

#54778F，#4EB043，#E69D2A，#DD4714，#A61650

OK，开始上色。

p4 <-
  p3 +
  scale_fill_gradientn(
    colors = c("#54778f", "#4EB043", "#E69D2A", "#DD4714", "#A61650"),
    guide = F
  )
p4

L4-5：载入渐变色板。

L6：删除fill图例。

这个时候就基本完成了。

我们来对比一下：

但相比人民日报的色板，我还是更喜欢viridis的色板。见下图

如需联系EasyShu团队

请加微信：EasyCharts

微信公众号【EasyShu】博文代码集合地址

https://github.com/Easy-Shu/EasyShu-WeChat

《R语言数据可视化之美》增强版

增强版配套源代码下载地址

Github

https://github.com/Easy-Shu/Beautiful-Visualization-with-R

百度云下载

https://pan.baidu.com/s/1ZBKQCXW9TDnpM_GKRolZ0w

提取码：jpou

猜你喜欢

10000+：菌群分析宝宝与猫狗梅毒狂想曲提DNA发Nature Cell专刊肠道指挥大脑

系列教程：微生物组入门 Biostar 微生物组宏基因组

专业技能：学术图表高分文章生信宝典不可或缺的人

一文读懂：宏基因组寄生虫益处进化树

必备技能：提问搜索 Endnote

文献阅读热心肠 SemanticScholar Geenmedical

扩增子分析：图表解读分析流程统计绘图

16S功能预测 PICRUSt FAPROTAX Bugbase Tax4Fun

在线工具：16S预测培养基生信绘图

科研经验：云笔记云协作公众号

编程模板: Shell R Perl

生物科普: 肠道细菌人体上的生命生命大跃进细胞暗战人体奥秘

写在后面

为鼓励读者交流、快速解决科研困难，我们建立了“宏基因组”专业讨论群，目前己有国内外5000+ 一线科研人员加入。参与讨论，获得专业解答，欢迎分享此文至朋友圈，并扫码加主编好友带你入群，务必备注“姓名-单位-研究方向-职称/年级”。PI请明示身份，另有海内外微生物相关PI群供大佬合作交流。技术问题寻求帮助，首先阅读《如何优雅的提问》学习解决问题思路，仍未解决群内讨论，问题不私聊，帮助同行。