Created
January 10, 2022 20:29
-
-
Save jmcastagnetto/97f834e16efc5b0e344516e7f589eb42 to your computer and use it in GitHub Desktop.
Una versión del gráfico espiral del NYT para los nuevos casos COVID-19 del Perú
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Ref: https://bydata.github.io/nyt-corona-spiral-chart/ | |
# https://github.com/bydata/nyt-corona-spiral-chart/blob/main/spiral-chart.R | |
library(tidyverse) | |
library(lubridate) | |
library(ggtext) | |
library(patchwork) | |
owid_url <- "https://github.com/owid/covid-19-data/blob/master/public/data/owid-covid-data.csv?raw=true" | |
country <- "Peru" | |
covid <- read_csv(owid_url) | |
covid_cases <- covid %>% | |
filter(location == country) %>% | |
select(date, new_cases, new_cases_smoothed) %>% | |
arrange(date) %>% | |
# Add the dates before the 1st confirmed case | |
add_row(date = as.Date("2020-01-01"), | |
new_cases = 0, new_cases_smoothed = 0, | |
.before = 1) %>% | |
complete(date = seq(min(.$date), max(.$date), by = 1), | |
fill = list(new_cases = 0, new_cases_smoothed = 0)) %>% | |
mutate(day_of_year = yday(date), | |
year = year(date) | |
) | |
text_color <- rgb(18, 18, 18, maxColorValue = 255) | |
base_family <- "Cabin" | |
# set date format for Peru | |
dummy <- Sys.setlocale("LC_TIME", "es_PE.UTF8") | |
subtitle_date <- max(covid_cases$date) %>% | |
format("%d de %B del %Y") | |
# Annotations for the years in a list (used in annotate()) | |
year_annotations <- list( | |
year = 2020:2022, | |
x = rep(3, 3), | |
y = as.POSIXct(paste(2020:2022, "01", "01", sep = "-")) | |
) | |
size_factor <- 3000 # a decent width with this scaling | |
# Colors | |
outline_color <- "#D97C86" | |
fill_color <- "#F0C0C1" | |
base_grey <- "grey28" | |
month_length <- c(31, 28, 31, 30, 31, 30, | |
31, 31, 30, 31, 30, 31) | |
month_breaks <- cumsum(month_length) - 30 | |
p <- covid_cases %>% | |
# 2020 is a leap year, we could drop Feb 29, 2020 for the sake of 365-day years | |
filter(date != as_date("2020-02-29")) %>% | |
group_by(year) %>% | |
mutate(day_of_year = row_number()) %>% | |
ungroup() %>% | |
ggplot() + | |
# area | |
geom_ribbon(aes(x = day_of_year, | |
ymin = as.POSIXct(date) - new_cases_smoothed / 2 * size_factor, | |
ymax = as.POSIXct(date) + new_cases_smoothed / 2 * size_factor, | |
group = year), | |
color = outline_color, size = 0.1, fill = fill_color, show.legend = FALSE) + | |
# basic line | |
geom_segment(aes(x = day_of_year, xend = day_of_year + 1, | |
y = as.POSIXct(date), yend = as.POSIXct(date)), | |
col = base_grey, size = 0.3) + | |
# annotation: 7d average | |
annotate("richtext", | |
label = "Promedio<br>de 7 días", | |
x = 20, y = as.POSIXct("2021-08-01"), | |
family = base_family, size = 2, color = text_color, | |
label.colour = NA, fill = NA) + | |
annotate("segment", | |
x = 20, xend = 22.5, | |
y = as.POSIXct("2021-06-01"), yend = as.POSIXct("2021-03-15"), | |
color = text_color, size = 0.1) + | |
# annotation: years | |
annotate("text", label = paste0(year_annotations$year, "\u2192"), x = year_annotations$x, | |
y = year_annotations$y, | |
size = 1.5, vjust = -0.6, hjust = 0.15) + | |
scale_x_continuous(minor_breaks = month_breaks, | |
breaks = month_breaks[c(1, 4, 7, 10)], | |
labels = c("Enero", "Abril", "Julio", "Octubre"), | |
limits = c(1, 365), | |
expand = c(0, 0) | |
) + | |
#' set the lower limit of the y-axis to a date before 2020 | |
#' so that the spiral does not start in the center point | |
scale_y_continuous(limits = c(as.POSIXct("2019-07-01"), NA), | |
expand = c(0, 0)) + | |
coord_polar() + | |
labs( | |
subtitle = subtitle_date | |
) + | |
theme_void(base_family = base_family) + | |
theme( | |
plot.background = element_rect(color = NA, fill = "white"), | |
panel.grid.major.x = element_line(color = "grey70", size = 0.2, linetype = "dotted"), | |
panel.grid.minor.x = element_line(color = "grey70", size = 0.2, linetype = "dotted"), | |
axis.text.x = element_text(color = base_grey, size = 6, hjust = 0.5), | |
text = element_text(color = text_color), | |
plot.subtitle = element_text(hjust = 0.5, size = 8) | |
) | |
#p | |
# Make legend graph | |
p_legend <- | |
tibble( | |
cases = c(0, 5000), | |
ymin = c(0, -2500), | |
ymax = c(0, 2500), | |
) %>% | |
ggplot(aes(cases)) + | |
geom_ribbon(aes(ymin = size_factor * ymin, ymax = size_factor * ymax), | |
color = outline_color, fill = fill_color, size = 0.3) + | |
geom_line(aes(y = 1), color = base_grey) + | |
geom_text(aes(label = ifelse(cases == 0, 0, "5,000 casos"), | |
y = 1, hjust = ifelse(cases == 0, 1.5, -0.1)), | |
size = 1.5) + | |
coord_cartesian(xlim = c(0, 350000), | |
ylim = c(-as.numeric(as.POSIXct("1971-01-01")), NA), | |
clip = "off") + | |
labs(title = "COVID-19 Peru<br>Nuevos casos") + | |
theme_void() + | |
theme(plot.title = element_markdown(color = text_color, | |
family = base_family, | |
face = "bold", size = 8, hjust = 0.2, | |
lineheight = 1.1)) | |
ragg::agg_png(here::here("plots", "peru_nyt_spiral_with-legend.png"), | |
res = 300, width = 1200, height = 1200 * 746/615) | |
p + inset_element(p_legend, left = 0.05, bottom = 0.725, right = 0.95, top = 0.95) | |
invisible(dev.off()) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
The code above comes, with very trivial and minor changes from the one described by @bydata in https://bydata.github.io/nyt-corona-spiral-chart/
Original tweet: https://twitter.com/_ansgar/status/1480557441012150272
Output below