COVID-19专题：绘制南丁格尔玫瑰图_

南丁格尔玫瑰图，又名“鸡冠花图”、“坐标区域图”，极区图等，是弗罗伦斯·南丁格尔所发明的。其本质是直方图，通过极坐标系转换为饼图形式：通常扇形的半径即是直方图的长度。由于玫瑰图是饼形展示的，数据对象较多时可避免直方图占用更多的横向排列空间。新冠肺炎期间，南丁格尔玫瑰图也受到了《人民日报》的青睐，绘制了全球各个国家（地区）新冠肺炎疫情形势（图1）。

图1 全球各个国家（地区）新冠肺炎疫情形势

那怎么实现类似的效果呢？下面我们用R语言的ggplot2包实现。

1 加载程序包

加载我们需要用到的程序包，代码如下：

library(openxlsx);library(dplyr);library(ggplot2)

2 数据准备1读取数据

我们收集到了截至4月28日全球各个国家的累计确诊病例数据，将其读取进来，数据结构如图2所示：

global"C:\Users\ Desktop\全球病例.xlsx",sheet =1)

图2部分原始数据示例

2数据整理

全球共有200多个国家确诊了新冠肺炎，我们筛选了部分国家以便更好地清楚绘制。在这里，我们以累计确诊病例数居前30的国家为例。

由于不同国家病例数量级非常大，变化程度也很大，我们在这里生成一个它的平方根值confirm1，用于后续画图。另外再生成新的变量id和label，用于后续给玫瑰图指定标签等。代码中%>%是管道函数，就是把符号左边的值发送给右边的表达式，并作为右边表达式函数的第一个参数（管道函数详细内容，可继续关注我们的公众号，将会有详细介绍）。代码和最后的数据结构如下：

global_30% arrange(desc(confirm)) %>% slice(1:30)global_30% mutate(country=factor(country,levels = country), confirm1=sqrt(confirm), id=seq(1,30,1), label=case_when(id15 ~ paste0(confirm,"例 ", country), id18 ~ paste0("例n",confirm,"n",country), id25 ~ paste0(confirm,"例n", country),T~ paste0(country,"n", confirm,"n","例") ))

图3部分整理数据展示

3 绘制玫瑰图

绘制直方图

由于玫瑰图本质是由直方图转换来的，我们先绘制直方图，代码和结果如下：

p geom_col(width =1, color ='white') + geom_col(aes(y = I(40)), width =1, alpha =0.5, fill ='white') + geom_col(aes(y = I(20)), width =1, alpha =0.2, fill ='white') + geom_col(aes(y = I(10)), width =1, color ='white', fill ='white') p

图4初步绘制的直方图

2坐标轴转换

在坐标轴转换之前，我们先利用scale_y_sqrt()语句对纵坐标进行再次压缩，目的在于进一步降低病例数量差带来图形上的影响。随后，利用coord_polar()将直角坐标轴转换为极坐标轴，去掉背景、坐标轴、图例等，进行颜色填充，代码和结果如下：

p1 #纵坐标取平方根以压缩纵坐标 coord_polar() +#极坐标转换，默认顺时针排序theme_void() + theme(legend.position="none")+ scale_fill_gradientn(colors = c("darkgreen","green","orange","red","firebrick"), trans ='sqrt')#颜色填充，颜色按平方根数映射p1

图5初步绘制的南丁格尔玫瑰图

3添加数据标签

最后，我们利用geom_text()加上数据标签，nudge_y用于调整其相对位置，angle指定其角度，size指定其大小，代码和结果如下：

p2% filter(id 15),nudge_y =5.5,angle =95-180* c(1:15) /15,fontface ="bold",size=3) + geom_text(data = . %>% filter(between(id,16,18)),nudge_y = -2,color ="white",fontface ="bold",size=2.3) + geom_text(data = . %>% filter(between(id,19,21)),nudge_y = -1.7,color ="white",fontface ="bold",size=2.6) + geom_text(data = . %>% filter(between(id,22,25)),nudge_y = -2.5,color ="white",fontface ="bold",size=3) + geom_text(data = . %>% filter(id >=26),nudge_y = -2.5,angle =80-75* c(1:5)/5,color ="white",fontface ="bold",size=3)p2