Skip to content

Instantly share code, notes, and snippets.

@mschnetzer
Last active March 25, 2020 10:53
Show Gist options
  • Save mschnetzer/7f6e04bfa41f1ff72c032774b1889cf3 to your computer and use it in GitHub Desktop.
Save mschnetzer/7f6e04bfa41f1ff72c032774b1889cf3 to your computer and use it in GitHub Desktop.
library(tidyverse)
library(rvest)
library(msthemes)
library(gganimate)
library(magick)
library(sf)
library(viridis)
url <- "https://de.wikipedia.org/wiki/COVID-19-Pandemie_in_%C3%96sterreich"
rawdat <- read_html(url) %>%
html_nodes(xpath = '//*[@id="mw-content-text"]/div/table[2]') %>%
html_table(fill = T, trim = T)
covid <- rawdat[[1]][-1,c(1:10)] %>%
magrittr::set_colnames(c("Datum","Burgenland","Kärnten","Niederösterreich","Oberösterreich","Salzburg","Steiermark","Tirol","Vorarlberg","Wien")) %>%
mutate_at("Datum", ~paste0(str_replace_all(str_sub(., 1, 6), "[.]", "/"),"2020")) %>%
mutate_at("Datum", ~lubridate::dmy(.)) %>%
mutate_at(vars(-Datum), list(~as.numeric(.))) %>%
gather("Bundesland", "Infektionen", 2:10)
rawtest <- read_html(url) %>%
html_nodes(xpath = '//*[@id="mw-content-text"]/div/table[3]') %>%
html_table(fill = T, trim = T, dec = ",")
tests <- rawtest[[1]] %>%
mutate_at("Datum", ~paste0(str_replace_all(str_sub(., 1, 6), "[.]", "/"),"2020")) %>%
mutate_at("Datum", ~lubridate::dmy(.)) %>%
mutate_at(vars(-Datum), list(~as.numeric(gsub("[.]","",.))))
rawbev <- read_html("http://www.statistik.at/web_de/klassifikationen/regionale_gliederungen/bundeslaender/index.html") %>%
html_nodes(xpath = '//*[@id="mitte"]/div/div[2]/div[1]/table') %>%
html_table(fill = T, trim = T, dec = ",")
bev <- rawbev[[1]][3:11,c(1,11)] %>%
magrittr::set_colnames(c("Bundesland","Bevölkerung")) %>%
mutate_at(vars(Bevölkerung), list(~as.numeric(gsub("\\D", "", .))))
##################################
##################################
map <- read_sf("~laender_999_geo.json") %>%
left_join(covid, by=c("name"="Bundesland"))
animap <- ggplot(data=map) +
geom_sf(aes(fill=Infektionen), color="black", size = 0.1) +
scale_fill_viridis_c(breaks = seq(0,max(covid$Infektionen),500),
name = "Infektionen, gesamt",
guide = guide_colorbar(
direction = "horizontal",
barheight = unit(2, units = "mm"),
barwidth = unit(70, units = "mm"),
title.position = "top",
title.hjust = 0.5)) +
theme_ms(dark = T) +
labs(title="Datum: {frame_time}") +
theme(axis.title = element_blank(),
axis.text = element_blank(),
legend.position = "bottom",
legend.title = element_text(size = 11),
panel.grid.major = element_blank()) +
transition_time(Datum)
a_gif <- animate(animap, width = 6, height = 5,
res = 150, unit = "in", end_pause = 40,
bg = "#464950")
a_mgif <- image_read(a_gif)
##################################
##################################
bars <- covid %>% left_join(bev) %>%
mutate(infbev = Infektionen/Bevölkerung*100000) %>%
ggplot(aes(x=Bundesland, y=infbev, fill=Infektionen)) +
geom_bar(stat='identity') +
scale_fill_viridis_c(guide=F, option = "D") +
scale_y_continuous(n.breaks = 4) +
scale_x_discrete(guide = guide_axis(n.dodge = 2)) +
theme_ms(dark = T) +
theme(axis.title.x = element_blank(),
axis.title.y = element_text(size = 12),
panel.grid.major.x = element_blank()) +
labs(y="Infektionen pro 100.000 EW") +
transition_time(Datum) +
ease_aes('sine-in-out')
b_gif <- animate(bars, width = 6, height = 5,
res = 150, unit = "in", end_pause = 40)
b_mgif <- image_read(b_gif)
##################################
##################################
rise <- covid %>% group_by(Datum) %>% summarise(Summe = sum(Infektionen)) %>%
ggplot(aes(x=Datum,y=Summe)) +
geom_line(size=1.2, color = "coral") +
geom_point(size = 1, color = "coral") +
scale_x_date(breaks = "1 week", date_labels = "%d.%m.") +
scale_y_continuous(n.breaks=6) +
theme_ms(dark = T) +
theme(axis.title.x = element_blank(),
axis.title.y = element_text(size = 12),
panel.grid.major.x = element_blank()) +
labs(y="Infektionen, gesamt") +
transition_reveal(Datum) +
ease_aes('sine-in-out')
c_gif <- animate(rise, width = 4, height = 5,
res = 150, unit = "in", end_pause = 40)
c_mgif <- image_read(c_gif)
##################################
##################################
new <- covid %>% group_by(Datum) %>%
summarise(Summe = sum(Infektionen)) %>%
mutate(Wachstum = Summe-lag(Summe)) %>%
ggplot(aes(x=Datum,y=Wachstum)) +
geom_line(size=1.2, color = "darkgoldenrod1") +
geom_point(size = 1, color = "darkgoldenrod1") +
scale_x_date(breaks = "1 week", date_labels = "%d.%m.") +
scale_y_continuous(n.breaks=6) +
theme_ms(dark = T) +
theme(axis.title.x = element_blank(),
axis.title.y = element_text(size = 12),
panel.grid.major.x = element_blank()) +
labs(y="Neuinfektionen") +
transition_reveal(Datum) +
ease_aes('sine-in-out')
d_gif <- animate(new, width = 4, height = 5,
res = 150, unit = "in", end_pause = 40)
d_mgif <- image_read(d_gif)
##################################
##################################
testing <- tests %>% select(Datum, Tests = `Tests in 24 h`) %>%
ggplot(aes(x=Datum,y=Tests)) +
geom_line(size=1.2, color = "aquamarine3") +
geom_point(size = 1, color = "aquamarine3") +
scale_x_date(breaks = "1 week", date_labels = "%d.%m.") +
scale_y_continuous(n.breaks=6) +
theme_ms(dark = T) +
theme(axis.title.x = element_blank(),
axis.title.y = element_text(size = 12),
panel.grid.major.x = element_blank()) +
labs(y="Tests pro Tag") +
transition_reveal(Datum) +
ease_aes('sine-in-out')
e_gif <- animate(testing, width = 4, height = 5,
res = 150, unit = "in", end_pause = 40)
e_mgif <- image_read(e_gif)
##################################
##################################
# Combine GIFs
top_gif <- image_append(c(a_mgif[1], b_mgif[1]))
low_gif <- image_append(c(c_mgif[1], d_mgif[1], e_mgif[1]))
new_gif <- image_append(c(top_gif, low_gif), stack =T)
for(i in 2:100){
top_combined <- image_append(c(a_mgif[i], b_mgif[i]))
low_combined <- image_append(c(c_mgif[i], d_mgif[i], e_mgif[i]))
combined <- image_append(c(top_combined, low_combined), stack = T)
new_gif <- c(new_gif, combined)
}
anim_save(filename = "corona.gif", animation = new_gif)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment