Swedish Vaccinations

NOTE: this is a practice project that may not function properly. Proceed with caution :)

COVID Vaccination Rates - Sweden

Data for the project sourced from Swedish Public Health Authority

Libraries Used

library(rvest)
library(tidyverse)
library(ggplot2)
library(rsconnect)
library(taskscheduleR)

Import Data

Using rvest, the application seeks the data from an HTML table on Folkhälsomyndigheten’s website. Whilst the agency does provide Excel data to download it is categorised weekly and not daily. Therefore, this application scrapes the daily figures from this table.

#Fetch NEW 
content <- read_html('https://www.folkhalsomyndigheten.se/smittskydd-beredskap/utbrott/aktuella-utbrott/covid-19/vaccination-mot-covid-19/statistik/statistik-over-registrerade-vaccinationer-covid-19/')

#Find and Convert table to df
vac_tab <- content %>% html_table(fill = TRUE)
sv_vac <- vac_tab[[2]]

Cleaning the data

The table is labelled in Swedish and stored as characters when downloaded. Therefore, this step is used to clean up the data so it is ready to be manipulated and improve ease of use.

#Translate Column Names
colnames(sv_vac) <- c("date", "first_total", "first_percent", "second_total", "second_percent")
#Clean Data TypeS
#Date as date
sv_vac$date <- as.Date(sv_vac$date)
#First dose total as number without space separator
sv_vac$first_total <- as.numeric(gsub(" ", "", sv_vac$first_total, fixed=FALSE))
#First dose percentage as number with . separator
sv_vac$first_percent <- as.numeric(gsub(",",".", sv_vac$first_percent, fixed=TRUE))
#Second dose total as number without space separator
sv_vac$second_total <- as.numeric(gsub(" ", "", sv_vac$second_total, fixed=TRUE))

NAs introduced by coercion

#Second dose percentage as number with . separator
sv_vac$second_percent <- as.numeric(gsub(",",".", sv_vac$second_percent, fixed=TRUE))

Adding the newly scraped data to an expanding dataset

The new data is downloaded and stored into the ‘sv_vac’ data frame, this steps takes the new data and joins it to ‘sv_vac_total’ which accumulates each new day of data.

#Load existing data
sv_vac_update <- readRDS(file="sv_vac_total_all.Rda")
#Add new data to temp update df
sv_vac_update <- bind_rows(sv_vac_update, sv_vac)
#Calculate first dose ONLY
sv_vac_update <- sv_vac_update %>% 
  mutate(first_dose_only = first_total - second_total) %>% 
  mutate(first_dose_only_pc = first_percent - second_percent)
#Eliminate NAs duplicates
sv_vac_update <- sv_vac_update %>% 
  arrange(date) %>% 
  filter(!is.na(first_total)) %>% 
  filter(duplicated(date) == FALSE)
#Save with Total #s
saveRDS(sv_vac_update, file="sv_vac_total_all.Rda")

Plotting the vacination rates

The data from FHM includes both total number and the percentage of people who have gotten the vaccination. The percentage of population is more meaningful than the raw numbers, so the graph uses those stats. You’ll notice that FHM does not publish data on Saturdays, Sundays and Mondays, hence the gaps in data.

#Load aggregate data
sv_vac_graph_data <- readRDS(file="sv_vac_total_all.Rda")
#ggplot
sv_vac_exp_graph <- ggplot(sv_vac_graph_data, aes(x=date)) +
  geom_line(aes(y= first_percent), color = "#ff6600") +
  geom_line(aes(y= second_percent), color = "#f8ccab") +
  geom_line(aes(y= first_dose_only_pc), color = "red") +
  geom_point(aes(y=first_percent), color = "#ff6600", shape=16, size=2) +
  geom_point(aes(y=second_percent), color = "#f8ccab", shape=16, size=2) +
  geom_point(aes(y=first_dose_only_pc), color = "red", shape=16, size=2) +
  labs(
    title = "% Vaccinated",
    subtitle = "First and Second Doses and Only One Dose",
    caption = "Source: Folkhälsomyndigheten",
    x = "Date",
    y = "Percentage Vaccinated") +
 # geom_text(aes(label = first_percent, y = first_percent), nudge_y = 0.5, nudge_x = 1) +
  #geom_text(aes(label = second_percent, y = second_percent), nudge_y = -1) +
  #geom_text(aes(label = first_dose_only_pc, y = first_dose_only_pc), color =  "red", nudge_y = 1) +
  scale_x_date(date_labels = "%d %b")

Graph

Note: due to the timing of this project and lack of daily dose date published in a retrievable format from FHM, the data starts from 25/02/2021. Also, colours may not be the best but were chosen to match the colours used by FHM in their official vaccination dashboard. This version [10/03/2021], also experiments with calculating the % of people who have ONLY received one dose. As compared to first dose which includes those who have received a second dose as well. The FHM dashboard is only updated once a week on Thursdays, 14:00 GMT+1. RED - ONLY 1st Dose; ORANGE - Total 1st Dose; PEACH - 2nd Dose.