一、引言
自从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 数据清洗和预处理
-
长格式转换
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_cases
1 Afghanistan X1.22.20 0
2 Albania X1.22.20 0
3 Algeria X1.22.20 0
4 Andorra X1.22.20 0
5 Angola X1.22.20 0
6 Antarctica X1.22.20 0
Country.Region date deaths
1 Afghanistan X1.22.20 0
2 Albania X1.22.20 0
3 Algeria X1.22.20 0
4 Andorra X1.22.20 0
5 Angola X1.22.20 0
6 Antarctica X1.22.20 0
-
数据的聚合
# 去除重复项目，方便整合
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 deaths
1 Afghanistan X1.22.20 0 0
2 Albania X1.22.20 0 0
3 Algeria X1.22.20 0 0
4 Andorra X1.22.20 0 0
5 Angola X1.22.20 0 0
6 Antarctica X1.22.20 0 0
-
计算世界各国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 719
10 Australia 113 3
# ℹ 191 more rows
# ℹ Use `print(n = ...)` to see more rows
-
过滤出确诊前26名国家
# 按确诊人数排序
data <- arrange(data, desc(confirmed_cases))
data_sever <- slice(data, 1:26)
data_mild <- slice(data, 27:nrow(data))
-
生成label参数
# 追加id
data_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))
# 直接画图，比例差距大的离谱，适当的缩放比例
四、开始画图
-
画出底图
# 由于比例差距太大了，做了一次开方，适当缩小比例差距
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
-
极坐标化
p2 <-p1 + coord_polar() +
theme_void() + scale_y_continuous(limits = c(-200, 2100))
p2
-
修改色谱
p3 <-
p2 +
scale_fill_gradientn(
colors = c("#54778f", "#4EB043", "#E69D2A", "#DD4714", "#A61650"),
guide = F
)
p3
-
加上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语言画出的图形，圆环部分特别小，如果适当的扩大图形，说不定会有更好的效果。目前技术有限，还不清楚怎么调整下部圈圈的大小，以及在相框等比扩大图形的问题需要解决，如果有知道的大佬，希望告知！
