John Burn-Murdoch của tạp chí Financial Times (FT) trong một bài viết trên Twitter có trích dẫn lại plot sau:
Plot này từng được đăng trên FT tại đây. Plot này có thể được tái tạo lại bằng cách sử dụng R như sau:
Dưới đây là R codes để tái tạo plot trên
# Clear work space:
rm(list = ls())
# Load R packages:
library(tidyverse)
library(lubridate)
library(ggtext)
library(glue)
library(zoo)
#----------------------------
# Prepare data for ploting
#----------------------------
# Load data:
<- "https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/jhu/new_deaths_per_million.csv"
owid_new_deaths_per_million_url
<- read_csv(owid_new_deaths_per_million_url)
covid_deaths
<- "https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/jhu/new_cases_per_million.csv"
owid_new_cases_per_million_url
<- read_csv(owid_new_cases_per_million_url)
covid_cases
# Set reporting period:
<- ymd("2022-02-01")
start_date
<- ymd("2022-03-11")
end_date
<- c("New Zealand", "Hong Kong")
nations_included
# Lag to shift cases:
<- duration("14 days")
lag_cases_deaths
%>%
covid_deaths mutate(metric = "deaths") %>%
bind_rows(covid_cases %>% mutate(metric = "cases")) %>%
pivot_longer(cols = -c("date", "metric"), names_to = "region", values_to = "new_per_million") %>%
filter(region %in% nations_included) %>%
group_by(region) %>%
mutate(new_per_million = replace_na(new_per_million, 0),new_per_100k = new_per_million / 10) %>%
mutate(new_per_100k_7drollmean = rollmean(new_per_100k, 7, fill = NA, align = "right"),
new_per_million_7drollmean = rollmean(new_per_million, 7, fill = NA, align = "right")) %>%
arrange(region) %>%
mutate(date2 = case_when(metric == "cases" ~ date + lag_cases_deaths, TRUE ~ date)) %>%
filter(date2 >= start_date, date2 <= end_date) -> covid_df_long
# Colors for our plot:
<- "#258BC3"
color_cases_text
<- "#71C8E4"
color_cases <- "#CE3240"
color_deaths
<- "#FFF1E5"
bgr_color
library(showtext) # -> Package for using extra fonts.
<- "Outfit" # -> Set Outfit font for our plot.
my_font
font_add_google(name = my_font, family = my_font) # -> Load font for using.
# Automatically render text:
showtext_auto()
<- seq(-80, 120, 20)
scales_on_y
<- as.character(scales_on_y) %>% str_replace_all("-", "")
y_text_label
<- case_when(scales_on_y > 0 ~ color_cases,
y_text_color < 0 ~ color_deaths,
scales_on_y TRUE ~ "grey30")
<- "Cases are translating into deaths at much higher rates in Hong Kong than\nin New Zealand, where elderly vaccination rates are much higher"
p_title
<- "Daily <b style='color:#71C8E4'>cases</b> per 100,000 people, and daily <b style='color:#CE3240'>deaths </b>per 2 million"
p_subtitle
<- "Source: FT analysis of data from Johns Hopkins CSSE. Cases shifted forward to account for lag between infection and death"
p_caption
<- data.frame(
country_annotations region = c("Hong Kong", "New Zealand"),
label = c(
glue("<span style='color: black; font-size: 14pt; font-family: \"Outfit\"'>
Hong Kong</span><br>
66% of over-80s unvaccinated<br>when Omicron took off<br>
<span style='color: {color_deaths}; font-family: \"Outfit\"'>Case fatality
<br>rate: 4.7%</span>"),
glue("<span style='color: black; font-size: 14pt; font-family: \"Outfit\"'>
New Zealand</span><br>
2% unvaccinated<br>
<span style='color: {color_deaths}; font-family: \"Outfit\"'>CFR: 0.1%</span>")))
# Replicate area plot originated by John Burn-Murdoch:
ggplot() +
geom_area(data = covid_df_long %>% filter(metric == "cases"), aes(date2, new_per_100k_7drollmean), fill = color_cases) +
geom_area(data = covid_df_long %>% filter(metric != "cases"), aes(date2, -2*new_per_million_7drollmean), fill = color_deaths) +
facet_wrap(~ region) +
scale_y_continuous(breaks = scales_on_y, labels = y_text_label, sec.axis = dup_axis()) +
scale_x_date(breaks = ymd(c("2022-02-01", "2022-03-01")), date_labels = "%b") +
theme(axis.title = element_blank()) +
theme(panel.grid.minor = element_blank()) +
theme(panel.grid.major.x = element_blank()) +
theme(plot.margin = unit(rep(1, 4), "cm")) +
theme(axis.text.y = element_text(color = y_text_color, family = my_font, size = 12)) +
theme(axis.text.x = element_text(family = my_font, size = 12, hjust = -0.05)) +
theme(plot.background = element_rect(color = NA, fill = bgr_color)) +
theme(panel.background = element_rect(color = NA, fill = NA)) +
theme(strip.text = element_blank()) +
theme(axis.ticks.y = element_blank()) +
theme(axis.ticks.length.x = unit(0.2, "cm")) +
theme(axis.ticks.x = element_line(color = "grey60", size = 0.8)) +
theme(panel.grid.major.y = element_line(size = 0.8, color = "grey90")) +
labs(title = p_title, subtitle = p_subtitle, caption = p_caption) +
theme(plot.title = element_text(family = my_font, size = 19, vjust = 2, hjust = 0)) +
theme(plot.subtitle = element_markdown(color = "grey30", family = my_font, size = 16)) +
theme(plot.caption = element_text(color = "grey30", family = my_font, size = 12, hjust = 0, vjust = -1.5)) +
geom_richtext(data = country_annotations,
aes(x = start_date, y = 115, label = label),
size = 4.8,
label.size = NA,
fill = NA,
family = my_font,
color = "grey30",
hjust = 0,
vjust = 1)
# Make FT icon:
library(grid)
grid.rect(x = 0, y = 1, width = 0.07, height = 0.01, just = c("left", "top"), gp = gpar(fill = "black", col = "black"))
Font chữ Outfit được sử dụng trong plot trên chưa phải là font chữ mà FT sử dụng. Để giống hơn có thể tham khảo các loại font chữ mà tạp chí này sử dụng tại đây hoặc font chữ do Kris Sowersby thiết kế mà tạp chí này sử dụng từ năm 2016.
Style màu sắc của tạp chí FT có thể được tham khảo tại đây.
Annotations có thể tham khảo bài giảng của CÉDRIC SCHERER từ khóa học Hands-On Data Visualization with ggplot2.
Một hướng dẫn khác tạo ra các graph của FT bằng R/ggplot2 tại đây.
Có thể sử dụng ftplottools - một package của R để tái lập lại các graphs của FT.