这是到目前为止我觉得讲解最为细致、仿制与色彩改进效果最好的疫情玫瑰图教程。所以特约稿给大家学习！作者码字不易，还请多多支持。
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
)
p1L7/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"
)
p3L4/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
)
p4L4-5：载入渐变色板。
L6：删除fill图例。
这个时候就基本完成了。
我们来对比一下：
但相比人民日报的色板，我还是更喜欢viridis的色板。见下图
