一、引言

自从COVID-19疫情在2020年爆发以来，数据可视化成为了了解疫情趋势和规模的重要手段。饱受争议的疫情数据可视化中的南丁格尔玫瑰图（Rose Chart），由于具有简洁、直观、易于理解等特点，逐渐成为了一个备受欢迎的数据可视化方式。

本文的目的是探讨如何使用南丁格尔玫瑰图来呈现COVID-19疫情数据，并介绍其基本原理和应用方法。通过本文，您将能了解如何绘制一个真实还原的COVID-19疫情玫瑰图，以及如何评估和选择适合的玫瑰图参数。此外，本文还将分析疫情玫瑰图的局限性和可能的出路，以及未来的发展方向。

二、什么是南丁格尔玫瑰图

2.1 定义和基本原理

南丁格尔玫瑰图是一种可以将数据按照分类分组并展现为平面角度的可视化方式，由英国护士和统计学家南丁格尔在19世纪60年代发明。在玫瑰图中，圆圈代表了整体，而每个扇形代表了一个分类变量。扇形的半径根据数据值而变化，通常采用不同的颜色或者角度来区分不同的类别。南丁格尔玫瑰图的本质是将多个条形图通过旋转而组合在一起组成一个圆形图。玫瑰图最常用的形式是展示一个周期内不同类别中数值的比例。

2.2 用途和优点

南丁格尔玫瑰图主要用于对多个分类数据进行可视化展示，并比较它们之间的比例关系。在近年来的数据可视化中，南丁格尔玫瑰图被广泛应用于展现疫情和其他方面的数据，比如营销数据分析、疾病分析、投票结果分布等。

相较于其他图表，南丁格尔玫瑰图具有以下几个优点：

• 直观性：玫瑰图的展示形式直观易懂，适合用于展示相对比例关系。
  
• 可比性：各扇形与总圆通常是同等的，人们可以自由地比较不同的类别。
  
• 可读性：数据值用大小来表示，颜色用来加强类别记忆。
  
• 易于制作：制作起来相对简单，常见的数据可视化软件均支持制作南丁格尔玫瑰图。
  

在下一部分，本文将介绍如何使用南丁格尔玫瑰图来展示COVID-19疫情数据。

三、数据集

3.1 获取确诊和死亡数据

# install.packages("readr")library(readr)# install.packages("tidyr")library(tidyr)confirmed_cases_url <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv"confirmed_cases_df <- read.csv(confirmed_cases_url) # 读取全球每日确诊数据

deaths_url <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_global.csv"deaths_df <- read.csv(deaths_url) # 读取全球每日死亡数据

3.2 数据清洗和预处理

1. 长格式转换
   

confirmed_cases_df <- confirmed_cases_df %>%   select(-c("Province.State", "Lat", "Long")) %>%  gather(key = "date", value = "confirmed_cases", -c("Country.Region"))head(confirmed_cases_df)

deaths_df <- deaths_df %>%   select(-c("Province.State", "Lat", "Long")) %>%  gather(key = "date", value = "deaths", -c("Country.Region"))head(deaths_df)

数据展示：

 Country.Region     date confirmed_cases1    Afghanistan X1.22.20               02        Albania X1.22.20               03        Algeria X1.22.20               04        Andorra X1.22.20               05         Angola X1.22.20               06     Antarctica X1.22.20               0

  Country.Region     date deaths1    Afghanistan X1.22.20      02        Albania X1.22.20      03        Algeria X1.22.20      04        Andorra X1.22.20      05         Angola X1.22.20      06     Antarctica X1.22.20      0

1. 数据的聚合
   

# 去除重复项目，方便整合confirmed_cases_df <- confirmed_cases_df[!duplicated(confirmed_cases_df[c("Country.Region", "date")]),]deaths_df <- deaths_df[!duplicated(deaths_df[c("Country.Region", "date")]),]

# 汇总数据集combined_data <- confirmed_cases_df %>%   left_join(deaths_df, by = c("Country.Region", "date")) 

head(combined_data)

结果展示：

  Country.Region     date confirmed_cases deaths1    Afghanistan X1.22.20               0      02        Albania X1.22.20               0      03        Algeria X1.22.20               0      04        Andorra X1.22.20               0      05         Angola X1.22.20               0      06     Antarctica X1.22.20               0      0

1. 计算世界各国2020-07-28日的确诊人数和死亡人数
   

data <- combined_data %>%  filter(date == "X7.28.20") %>%  group_by(Country.Region)  %>%  summarise(confirmed_cases = sum(confirmed_cases, na.rm = TRUE),            deaths = sum(deaths, na.rm = TRUE))

data

结果展示：

# A tibble: 201 × 3   Country.Region      confirmed_cases deaths   <chr>                         <int>  <int> 1 Afghanistan                   36454   1274 2 Albania                        4997    148 3 Algeria                       28615   1174 4 Andorra                         907     52 5 Angola                         1000     47 6 Antarctica                        0      0 7 Antigua and Barbuda              86      3 8 Argentina                    173355   3179 9 Armenia                       37629    71910 Australia                       113      3# ℹ 191 more rows# ℹ Use `print(n = ...)` to see more rows

1. 过滤出确诊前26名国家
   

# 按确诊人数排序data <- arrange(data, desc(confirmed_cases))data_sever <- slice(data, 1:26)data_mild <- slice(data, 27:nrow(data))

1. 生成label参数
   

# 追加iddata_sever <- data_sever %>%  mutate(id = 1:nrow(data_sever))

dat <- data_sever %>%  mutate(    label = case_when(      id <= 5  ~ paste0(Country.Region, "国\n", confirmed_cases, "例"),      id <= 13 ~ paste0(confirmed_cases, "例\n", Country.Region, "国"),      T ~ paste0(confirmed_cases, "例 ", Country.Region, "国")    )  )

# 逆向排序dat <- arrange(dat,confirmed_cases)dat <- select(dat, -id)dat <- dat %>%  mutate(id = 1:nrow(dat))

# 直接画图，比例差距大的离谱，适当的缩放比例

四、开始画图

1. 画出底图
   

# 由于比例差距太大了，做了一次开方，适当缩小比例差距dat$sqrt <- sqrt(dat$confirmed_cases)p1 <- ggplot(data = dat, aes(x = id, y=confirmed_cases,            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

1. 极坐标化
   

p2 <-p1 + coord_polar() +   theme_void() + scale_y_continuous(limits = c(-200, 2100))p2

1. 修改色谱
   

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

1. 加上label
   

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

五、结论

这次图形虽然再现成功了，但是还是有很大的差距的。死亡人数这个我计算出来了，但是排上去的话还是很不好看，所以拿下来了。这次碰到的主要问题是R语言画出的图形，圆环部分特别小，如果适当的扩大图形，说不定会有更好的效果。目前技术有限，还不清楚怎么调整下部圈圈的大小，以及在相框等比扩大图形的问题需要解决，如果有知道的大佬，希望告知！