In miraisolutions/covid19-vaccination-ch: Vaccination Breakthroughs in CH
# store params also for server
knit_params <- params
# Default code chunk setup
knitr::opts_chunk$set(echo = FALSE, collapse = FALSE, comment = "")
# knitr::opts_chunk$set(echo = FALSE, prompt = FALSE, collapse = FALSE)
# def.chunk.hook <- knitr::knit_hooks$get("chunk")
# important to fix it, as this is set dynamically by RStudio
options(width = 80)
load_pkg_c19 <- function(usepkgload) {
if (usepkgload) {
pkgload::load_all(export_all = FALSE, helpers = FALSE, attach_testthat = FALSE)
}
if (!("covid19vaccinationch" %in% search())) {
library(covid19vaccinationch)
}
NULL
}
library(jsonlite)
library(dplyr)
library(tidyr)
library(stringr)
library(ggplot2)
library(plotly)
library(tidyselect)
library(scales)
library(htmlTable)
library(lubridate)
library(shiny)
# # we use a font size relative to the responsive body font size (em)
# #
table_css <- "border-collapse: separate; border-spacing: 0.25em; width: 100%; font-size: 0.7em; margin-bottom: 14.5px;"
table_cell_css <- "white-space: nowrap; font-size: .95em;" # relative to the table_css
load_pkg_c19(params$use_pkgload)
load_pkg_c19(knit_params$use_pkgload)
Since May 2020 Mirai Solutions is showing a dashboard on our gallery{target="_blank"} that contains a global view of the COVID-19 Pandemic{target="_blank"} with a further split by continent and country. We use publicly available data from the COVID-19 Data Hub{target="_blank"}, a great open source project providing a unified data set put together from numerous official local sources from all over the world.
In October and December 2021 we published 2 articles "A closer look at Vaccination breakthroughs in Switzerland"{target="_blank"} and "A 2nd look at Vaccination breakthroughs in Switzerland"{target="_blank"}, where we showed how to read data from the Swiss Federal Office for Public Health (BAG){target="_blank"} in R, and illustrated the difference in Hospitalizations and Deaths between Vaccinated and Unvaccinated during the weeks in October and December.
Here we provide a live update to these articles deployed to shinyapps.io{target="_blank"} that will always show the latest data from BAG.
Reading BAG data
To see how we read BAG data in R please refer to the previous article{target="_blank"}.
We are interested in the weekly BAG reports about vaccination breakthroughs occurred in the last 4 weeks for different age classes. See data documentation{target="_blank"} and our source: opendata.swiss{target="_blank"}.
# bag_api_url = covid19vaccinationch:::bag_api_url
bag_api_url <- "https://www.covid19.admin.ch/api/data/context/"
The data documentation makes us aware of the following restrictions and warnings about the collected data:
- During the vaccination campaign the populations of "Vaccinated" and "Unvaccinated" changed, i.e. the vaccinated population has slightly increased.
- Many infected people have "Unknown" vaccination status, therefore this source has been disabled by BAG, while a more complete information is available for Hospitalized and Deaths cases.
To solve the former problem (1.) we will use the average of the "Vaccinated" an "Unvaccinated" population sizes across the month.
if (params$fetch_latest_data) {
message("** reading Vac data from Source **")
DATA = read_bag_data_vac(bag_api_url, ageclassMap)
} else {
# read from RDS
DATA <- readRDS(file.path(data_path(), "DATA.rds"))
}
# aggregation to new age classes
DATA.AGG = DATA %>%
group_by(Week,AgeClass, vaccination_status ) %>%
summarise_if(is.numeric, sum, na.rm = TRUE)
weeks4 = tail(unique(DATA.AGG$Week), 4)
period = paste(range(weeks4), collapse = "-")
DATA.AG4W <- DATA.AGG %>% filter(Week %in% weeks4)
# read Cases, from RDS
if (params$fetch_latest_data) {
message("** reading Infection data from Source **")
CASES = read_bag_data_cases(bag_api_url, ageclassMap, dateweek = unique(DATA$Week))
} else {
# read from RDS
CASES <- readRDS(file.path(data_path(), "CASES.rds"))
}
CASES.AGG = CASES %>%
group_by(Week,AgeClass ) %>%
summarise_if(is.numeric, sum, na.rm = TRUE)
CASES.AG4W <- CASES.AGG %>% filter(Week %in% weeks4)
weeks_from_to <- weeks_to_date(weeks4, range = TRUE)
periodLabel = paste("(", paste(weeks_from_to, collapse = ","),")", sep = "")
As of Today (r Sys.Date()) the 4 last weeks considered are: r weeks4 (YY-W-Week Number), i.e. in the interval from r weeks_from_to[1] to r weeks_from_to[2].
The age categories have been redefined again as: r unique(ageclassMap$AgeClass).
Last 4 weeks Cases and Vaccination
aggrvars = names(DATA.AG4W) [sapply(DATA.AG4W, is.numeric)] %>%
grep(pattern = "_tot$", value = TRUE, invert = TRUE) %>%
grep(pattern = "^pop", value = TRUE, invert = TRUE)
cumvars = setdiff(names(DATA.AG4W)[sapply(DATA.AG4W, is.numeric)], aggrvars)
# Aggregate to last month figures
DATA.AG1M <- aggregate_to_month(DATA.AG4W, period, aggv = aggrvars, cumv = cumvars)
CASES.AG1M <- aggregate_to_month(CASES.AG4W, period, by = "AgeClass",
aggv = "confirmed", cumv = c("pop", "confirmed_tot"))
# prepare data for Cases plot
datacases <- DATA.AG1M %>%
select(Week, AgeClass, deaths, hosp, vaccination_status, pop) %>%
group_by(Week, AgeClass) %>% # remove vaccination
summarize(across(where(is.numeric), sum)) %>%
ungroup() %>%
# merge with cases
left_join(CASES.AG1M %>% select(-pop,-confirmed_tot), by = c("Week", "AgeClass"))
# assign unknown Age Class to all
datacases$confirmed[datacases$AgeClass == "All"] = datacases$confirmed[datacases$AgeClass == "All"] +
datacases$confirmed[datacases$AgeClass == "unknown"]
datacases$hosp[datacases$AgeClass == "All"] = datacases$hosp[datacases$AgeClass == "All"] +
datacases$hosp[datacases$AgeClass == "unknown"]
datacases$deaths[datacases$AgeClass == "All"] = datacases$deaths[datacases$AgeClass == "All"] +
datacases$deaths[datacases$AgeClass == "unknown"]
datacases <- datacases %>%
filter(!AgeClass %in% c("unknown")) %>%
rename(AsOfDate = Week) %>% bind_cols() %>%
pivot_longer(cols = c("confirmed", "deaths", "hosp"), names_to = "Case", values_to = "Value") %>%
mutate(Case = factor(Case, levels = c("confirmed", "hosp", "deaths"), labels = c("Infections", "Hospitalizations", "Deaths")))
.extract_value <- function(data, case, age = "All", val = "Value") {
data %>% filter(AgeClass %in% age & Case == case) %>% as.data.frame() %>% .[, val] %>%
formatC(format = "f", big.mark = "'", digits = 0)
}
The current situation of the last 4 weeks as of r weeks_from_to[2], i.e. how the infections, hospitalizations and deaths occurred across the age classes in absolute terms is shown below. Overall during this period Switzerland has registered r .extract_value(datacases, "Infections") infections, r .extract_value(datacases, "Hospitalizations") hospitalizations and r .extract_value(datacases, "Deaths") deaths.
datacasesAges = datacases %>%
filter(!AgeClass %in% c("All"))
plotcol <- pick_vac_lev_col("not_vaccinated")
BarplotCovid(datacasesAges, g_palette = plotcol, X = "AgeClass", FACET = "Case", percent = FALSE)
To account for different distribution of the population in the Age Classes consider the Incidence over 100'000 inhabitants:
datacases100k = datacases %>% mutate(Value = Value / pop * 100000)
# plotcol <- c(rep(pick_vac_lev_col("not_vaccinated"), length(unique(ageclassMap$AgeClass))), "firebrick4")
plotcol <- pick_vac_lev_col("not_vaccinated")
BarplotCovid(datacases100k, g_palette = plotcol,
X = "AgeClass", FACET = "Case", percent = FALSE)
Infections happen more frequently in younger age classes (at least in absolute terms) while Hospitalizations and Deaths are more common among the older ones.
Current Vaccination Status
The current vaccination status per age group as of r weeks_from_to[2] is shown below. The "Fully Vaccinated" population is split according to the occurred injection of the Booster dose.
Pop <- DATA.AG1M %>%
filter((!AgeClass %in% c("unknown"))) %>%
select(-Week) %>%
group_by(AgeClass) %>%
summarize(pop = sum(pop)) %>%
mutate(AsOfDate = unique(DATA.AG1M$Week)) %>%
ungroup()
datavacc <- DATA.AG1M %>%
select(Week, AgeClass,pop, vaccination_status) %>%
filter((!vaccination_status %in% c("Unknown","Unvac.")) & (!AgeClass %in% c("unknown"))) %>%
mutate(Status = factor(vaccination_status, levels = rev(names(vac_levels())[c(-1,-length(vac_levels()))]))) %>%
rename(AsOfDate = Week, Value = pop) %>%
left_join(Pop, by = c("AsOfDate", "AgeClass")) %>%
mutate(Vax = Value ) %>%
mutate(Value = Vax / pop) %>%
select(-vaccination_status)
datavacall <- datavacc %>% filter(AgeClass == "All") %>%
#arrange(!!sym(FILL)) %>%
mutate(Value = cumsum(Value)) %>%
ungroup() %>%
mutate(Value = .funformat(Value * 100, TRUE),
Vax = .funformat(Vax, FALSE))
plotcol <- pick_vac_lev_col(c("partially_vaccinated", "fully_vaccinated_no_booster", "fully_vaccinated_first_booster"))
StackedBarplotCovid(datavacc, g_palette = c(plotcol), X = "AgeClass", FILL = "Status",
position = "stack", title = "Vaccination Status per age", percent = TRUE)
r datavacall %>% filter(Status %in% names(vac_levels())[vac_levels() == "fully_vaccinated_no_booster"]) %>% .[,"Value"] of the Swiss population is fully vaccinated (2 doses), r datavacall %>% filter(Status %in% names(vac_levels())[vac_levels() == "partially_vaccinated"]) %>% .[,"Value"] has received at least one dose, while r datavacall %>% filter(Status %in% names(vac_levels())[vac_levels() == "fully_vaccinated_first_booster"]) %>% .[,"Value"] has received the booster dose.
When making a comparison between the Vaccinated and Unvaccinated it is worth first highlighting the differences between the 2 populations that would bias such comparison.
The biggest difference is the younger age of the "Unvaccinated" population, less likely to be impacted by Covid-19. For this reason the data are grouped in Age Classes, even within the same class, there can be are other differences to consider that may make a population more or less inclined to infection, and hence to hospitalizations. Measures in the Age Class "All" have to be age-adjusted.
Further bias is introduced by the fact that "Unvaccinated" may have recovered from Covid and therefore have a protection. Unfortunately we cannot extract relevant information from BAG that would allow us to exclude the already Infected from the "Unvaccinated" population. We can show here the % of total contagion in the global population and warn the readers that a "small" % of the "Unvaccinated" is NOT unprotected (leading to underestimation of the positive effect of vaccination).
TotConfirmed <- CASES.AG1M %>% filter(AgeClass != "unknown") %>% select(AgeClass,confirmed_tot, pop)
TotConfirmed <- TotConfirmed %>%
mutate(Percentage = confirmed_tot / pop * 100) %>%
rename(Population = pop, Infections = confirmed_tot) %>%
pivot_longer(cols = c("Population", "Infections", "Percentage"), names_to = "Case", values_to = "Value") %>%
mutate(Case = factor(Case, levels = c("Population", "Infections", "Percentage"), labels = c("Population", "Infections", "Percentage"))) %>%
rename(value = Value)
TotConfirmed %>%
mutate(value = ifelse(value < 100, paste(round(value, 1), "%"), # simplified
formatC(round(value), format = "f", big.mark = "'", digits = 0))) %>%
addHtmlTableStyle(
align = "c", css.table = sub(" *margin-bottom.*?;", "", table_css),
css.cell = color_cells(TotConfirmed, header = "Case", rnames = "AgeClass", table_cell_css = table_cell_css)
) %>%
tidyHtmlTable(header = Case ,
#cgroup = c(Case),
rnames = AgeClass,
caption = paste("Table 1: Confirmed Infections per Age Class.", weeks_from_to[2]))
It is worth mentioning other possible sources of bias that can't be isolated, some of these differences could actually cause a bias in both directions.
- Leading to underestimation of vaccination effect:
- People with chronic diseases are over-represented in the "Vaccinated" population (visible from BAG website).
- During 3G-2G rule (green pass) the "Unvaccinated" have been less present in risky locations
- Hospitalized "with" Covid, i.e. recorded positive upon hospitalization, are counted as Covid patients, despite they are not in hospital because of Covid.
We are happy to hear more from the readers about this topic and possibly collect sources that could give a better insight. We can neglect of course possible causes of bias for Infections (e.g. lower test tendency of the "Vaccinated") that would not lead to a possible hospitalization, as Infections are not treated in this article.
Last 4 weeks vaccination breakthrough cases
UPDATE 2022-11: as it can be seen from the large numbers in the Unknown catefory, BAG does not keep track properly any more of the vaccination status.
A view of the absolute figures of all vaccination categories, including "Unknown", i.e. not reported.
DataPlot <- DATA.AG1M %>%
select(Week, AgeClass, vaccination_status, hosp, deaths, pop) %>%
filter(!AgeClass %in% c("unknown")) %>%
rename(AsOfDate = Week, population = pop) %>% bind_cols() %>%
pivot_longer(cols = c("population","hosp", "deaths"),
names_to = "Case", values_to = "Value") %>%
mutate(Case = factor(Case, levels = c("population","hosp","deaths"), labels = c("Population", "Hospitalizations", "Deaths")))
DataTab <- DataPlot %>%
rename(Status = vaccination_status) %>%
rename(value = Value)
.calc_perc_unknwon <- function(data, case) {
perc <- (data %>% filter(Case == case & vaccination_status == "Unknown" & AgeClass == "All") %>% .[,"Value"] / data %>% filter(Case == case & AgeClass == "All") %>% summarize(totcases = sum(Value)) %>% .[, "totcases"]) %>% as.data.frame() %>% .[, "Value"]
paste(round(perc * 100,1), "%")
}
DataPlotTab1 <- DataPlot %>%
#filter(AgeClass != "All") %>%
rename(Status = "vaccination_status")
StackedBarplotCovid(DataPlotTab1, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(vac_levels_colors()), position = "fill", title = "Vaccinated vs Unvaccinated Cases")
Overall the vaccination status is "Unknown" for r .calc_perc_unknwon(DataPlot, "Hospitalizations") of the Hospitalized and for r .calc_perc_unknwon(DataPlot, "Deaths") of the Deaths.
# DataTab = DataPlot %>%
# rename(Status = vaccination_status) %>%
# rename(value = Value)
DataTab %>%
filter(!Case %in% c("Infections")) %>%
select(-AsOfDate) %>%
mutate(value = formatC(round(value), format = "f", big.mark = "'", digits = 0)) %>%
addHtmlTableStyle(
align = "c", css.table = sub(" *margin-bottom.*?;", "", table_css),
css.cell = color_cells(DataTab %>%
filter(!Case %in% c("Infections")) %>%
select(-AsOfDate), header = "Status", cgroup = "Case", rnames = "AgeClass", table_cell_css = table_cell_css)
) %>%
tidyHtmlTable(header = Status ,
cgroup = c(Case),
rnames = AgeClass,
caption = paste("Table 2: absolute entries per age and vaccination status.", periodLabel))
There is no hint of whether the "Unknown" entries tend to be more or less vaccinated (checking their curves in the BAG site they seem to be somewhere in between), therefore it can make sense to reassign proportionally these cases to the others vaccination categories.
#Allocate Unknown to the other cats
DataTabScale <- rescale_unknown(DataTab)
DataTabScale %>%
mutate(value = formatC(round(value), format = "f", big.mark = "'", digits = 0)) %>%
mutate(value = ifelse(value == "NaN", "", value)) %>%
select(-AsOfDate) %>%
addHtmlTableStyle(
align = "c", css.table = table_css, css.cell = color_cells(DataTabScale %>% select(-1), header = "Status" ,
cgroup = "Case",
rnames = "AgeClass")
) %>%
tidyHtmlTable(header = Status ,
cgroup = Case,
rnames = AgeClass,
caption = paste("Table 3: entries per age and vaccination status. Reallocation of Unknown vaccination status.", periodLabel))
After this reallocation let's look at the records over 100'000 people in each reference Age Class and vaccination status, and at the ratio between the "Unvaccinated" and "Vaccinated" cases. This view will be used also in the following sections. When accounting for the total, i.e. "All" Age Class, age adjusted figures have been computed accounting for the different distribution of the "Vaccinated" and "Unvaccinated" groups across the different Age Classes.
# scale to 100k
DataPlot100kScale <- make_100k(DataTabScale %>% rename(Value = value),
by = c("AsOfDate","AgeClass", "Status"), status = "Status")
DataPlot100kScale2 = DataPlot100kScale %>%
filter( Case != "Population")
StackedBarplotCovid(DataPlot100kScale2, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(vac_levels_colors()[-1]), position = "fill", title = "Vaccinated vs Unvaccinated Cases per 100'000 people")
The ratio of the impact per 100'000 people of the "Fully Vaccinated" vs the "Unvaccinated" measures the vaccination effect and the risk of Hospitalization or Death of the "Unvaccinated" versus the "Vaccinated".
DataPlot100kScaleRatios <- calc_ratio_fullyvac(DataPlot100kScale) %>%
filter(Status %in% names(vac_levels())[grep("fully", vac_levels())])
DataPlot100kScaleRatiosPlot = DataPlot100kScaleRatios %>%
filter(Variable == "Ratio over Unvac.") %>%
rename(Value = value)
plotcol <- pick_vac_lev_col(c("fully_vaccinated_first_booster", "fully_vaccinated_no_booster"))
StackedBarplotCovid(DataPlot100kScaleRatiosPlot %>% select(-Variable) , g_palette = c(plotcol),
X = "AgeClass", FILL = "Status", FACET = "Case", percent = FALSE, title = "Ratio of Unvac. Impact vs Fully Vac", position = "dodge")
DataPlot100kScaleRatios %>%
mutate(value = replace_na(as.character(value), "")) %>%
addHtmlTableStyle(
align = "c", css.table = table_css,
css.cell = color_cells(DataPlot100kScaleRatios %>%
select(-pop, -AsOfDate), header = "Status" ,
cgroup = c("Case","Variable"),
rnames = "AgeClass", table_cell_css = table_cell_css)
) %>%
tidyHtmlTable(header = Status ,
cgroup = c(Case,Variable),
rnames = AgeClass,
caption = paste("Table 4: entries over 100'000 people per age and vaccination status. Reallocation of Unknown vaccination status.", periodLabel),
skip_removal_warning = TRUE)
The estimate indicate that the "Unvaccinated" people have r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_first_booster") & grepl("Ratio", Variable) & Case == "Hospitalizations") %>% as.data.frame() %>% .[,"value"] times higher risk to be hospitalized, r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_first_booster") & grepl("Ratio", Variable) & Case == "Deaths") %>% as.data.frame() %>% .[,"value"] times higher risk to die compared with a "Fully Vaccinated with Booster", while r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_no_booster") & grepl("Ratio", Variable) & Case == "Hospitalizations") %>% as.data.frame() %>% .[,"value"] and r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_no_booster") & grepl("Ratio", Variable) & Case == "Deaths") %>% as.data.frame() %>% .[,"value"] times higher compared with "Fully Vaccinated without Booster".
Scenario Analysis
Assuming there are 3 possible Scenarios to add to the current one: what if there had been no vaccinated at all this month? Or if we had been all vaccinated? What if all with Booster?
These opposite scenarios can be generated and compared with what really happened in the last 4 weeks ("Current") by taking the Hospitalization and Death rates over 100'000 people of the unvaccinated ("No Vac.") and vaccinated ("Vac. Booster" / "Vac No Booster") populations and projecting them over the full population.
Worth mentioning that the protection given by the vaccines against infection is also to consider as source of bias in this scenario analysis:
- If there was no vaccination at all the "Unvaccinated" would have worse figures, as they would not benefit of the presence of a vaccinated population and they would have more infections.
- On the contrary, there would be fewer cases among the "Vaccinated" (and hence hospitalizations and deaths) if the whole population had received a full protection.
Despite the decay of vaccination benefits over time and against infections (Omicron), this is still a factor to consider.
The Incidence over 100'000 people in the 3 scenarios + "Current" are presented below:
datacases100k = datacases100k %>% mutate(Status = "current")
DataPlot100kp = DataPlot100kScale %>%
filter(Status %in% names(vac_levels()[c(5,3,2)])) %>%
bind_rows(datacases100k) %>%
mutate(Status = factor(Status, levels = c("Unvac.","current",names(vac_levels()[c(3,2)])),
labels = c("No Vac.","Current", "Vac. No Booster", "Vac. Booster"))) %>%
filter(Case %in% c("Hospitalizations","Deaths")) %>%
arrange(AgeClass,Status,Case)
plotcol <- c(pick_vac_lev_col(c("not_vaccinated")),
col_current_status(),
pick_vac_lev_col(c("fully_vaccinated_no_booster", "fully_vaccinated_first_booster")))
StackedBarplotCovid(DataPlot100kp, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(plotcol), position = "dodge",
title = "Hosp. and Deaths per 100k for each scenarios")
More importantly, projecting the values of the 3 scenarios on the whole population we can evaluate the vaccination impact in absolute terms.
DataPlotp = DataPlot100kp %>%
select(-pop) %>%
left_join(Pop, by = c(c("AsOfDate", "AgeClass"))) %>%
mutate(Value = round(Value*pop / 100000))
DataPlotpTab7 = DataPlotp %>%
filter(AgeClass != "All")
plotcol <- c(pick_vac_lev_col(c("not_vaccinated")),
col_current_status(),
pick_vac_lev_col(c("fully_vaccinated_no_booster", "fully_vaccinated_first_booster")))
StackedBarplotCovid(DataPlotpTab7, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(plotcol), position = "dodge",
title = "Hosp. and Deaths for each scenarios")
DataTabp <- DataPlotp %>% select(-pop, AsOfDate) %>%
rename(value = Value)
DataTabp %>%
addHtmlTableStyle(
align = "c", css.table = table_css,
css.cell = color_cells(DataTabp %>% select(-1), header = "Status" ,
cgroup = "Case",
rnames = "AgeClass", table_cell_css = table_cell_css#, skip = "Total"
)
) %>%
tidyHtmlTable(header = Status,
cgroup = Case,
rnames = AgeClass,
caption = paste("Table 5: Scenarios per age and vaccination status. Reallocation of Unknown vaccination status.", periodLabel),
skip_removal_warning = TRUE)
If there had been no vaccination at all, in the last 4 weeks there would have been r DataTabp %>% filter(AgeClass == "All" & Status == "No Vac." & Case == "Hospitalizations") %>% as.data.frame() %>% .[,"value"] %>% .funformat(FALSE) Hospitalizations and r DataTabp %>% filter(AgeClass == "All" & Status == "No Vac." & Case == "Deaths") %>% .[,"value"] %>% .funformat(FALSE) Deaths, on the contrary, if all had received booster, there would have been r DataTabp %>% filter(AgeClass == "All" & Status == "Vac. Booster" & Case == "Hospitalizations") %>% .[,"value"] %>% .funformat(FALSE) Hospitalizations and r DataTabp %>% filter(AgeClass == "All" & Status == "Vac. Booster" & Case == "Deaths") %>% .[,"value"] %>% .funformat(FALSE) Deaths.
Time line of reported case
This section reports how the cases developed over time within the 3 populations. Please note, differentiating according to the actual date of vaccination (e.g. if earlier than or within 6 months) is not possible.
Figures per 100'000 people are shown again, reallocating those in the "Unknown" category in each analyzed week.
ageclasses2 <- sort(unique(ageclassMap$AgeClass2))
DataRoll4W100k <- readRDS(file.path(data_path(), "DataRoll4W100k.rds")) %>%
filter(Status != "Partially vac.") # remove partial vac
#last_timeline_weeks <- tail(unique(DataRoll4W100k$AsOfDate), 40)
last_timeline_weeks <- unique(DataRoll4W100k$AsOfDate)
# zero out data for booster prior to reaching 10% boosted
threshold.vax = 0.2
first.week.vac <- DataRoll4W100k %>%
filter(AgeClass == "All", Status == "Fully vac. No Booster", Case == "Deaths") %>% select(AsOfDate, pop) %>%
left_join(DataRoll4W100k %>% filter(AgeClass == "All") %>% group_by(AsOfDate) %>%
summarise(sumpop = sum(pop)), by = "AsOfDate") %>%
mutate(VaxPop = pop/sumpop) %>% filter(VaxPop > threshold.vax) %>% .[1, "AsOfDate"]
last_timeline_weeks <- unique(DataRoll4W100k$AsOfDate[DataRoll4W100k$AsOfDate >= as.character(first.week.vac)])
threshold.boostervax = 0.1
first.week.booster <- DataRoll4W100k %>%
filter(AgeClass == "All", Status == "Fully vac. Booster", Case == "Deaths") %>% select(AsOfDate, pop) %>%
left_join(DataRoll4W100k %>% filter(AgeClass == "All") %>% group_by(AsOfDate) %>%
summarise(sumpop = sum(pop)), by = "AsOfDate") %>%
mutate(VaxPop = pop/sumpop) %>% filter(VaxPop > threshold.boostervax) %>% .[1, "AsOfDate"]
# override values for booster
DataRoll4W100k <- DataRoll4W100k %>% mutate(Value = ifelse(Status == "Fully vac. Booster" & AsOfDate < as.character(first.week.booster), NA, Value))
The "Partially Vaccinated" population has been removed while the Booster status is shown only since r first.week.booster[1] (r weeks_to_date(as.character(first.week.booster[1]), range = FALSE)), i.e. when Booster doses had been administered to at least r paste0(threshold.boostervax[1]*100, "%") of the population. In order to include more data also during low-waves periods the age Classes are restricted to 4: r ageclasses2. We also reduce the time-line to start from week r last_timeline_weeks[1], corresponding to the date r weeks_to_date(last_timeline_weeks[1], range = FALSE) when at least r paste0(threshold.vax[1]*100, "%") of the population was fully vaccinated.
In this part the calculations done so far are replicated for each week in the time-line, i.e. for a given week the report's figures related to its past 4 weeks are being recalculated. In this way the lines can appear smoother and make the estimates more reliable (at least for over 40 where there are enough data).
The graph below shows the incidence over 100'000 people for each Age and Vaccination class, choose between Hospitalized or Deaths cases and their Vaccination Status.
status1 <- names(vac_levels())[grep("fully_vaccinated|not_vaccinated", vac_levels())]
#data1 <- DataRoll4W100k %>% filter(AsOfDate %in% last_timeline_weeks)
#UI
fluidRow(
column(3, offset = 1,
selectInput(inputId = "case1", label = "Hospitalizations or Deaths",
choices = c("Hospitalizations","Deaths"), selected = "Hospitalizations",
selectize = TRUE)
),
column(3,
selectInput(inputId = "status1", label = "Vac. Status",
choices = c("All",status1), selected = "All",
selectize = TRUE)
)
)
plotlyOutput("lineplot1")
#SERVER
data1 <- DataRoll4W100k %>% filter(AsOfDate %in% last_timeline_weeks)
output$lineplot1 <- renderPlotly({
if (is.null(input$case1))
return(plot.new())
res <- filter_dataplot(data1, input$status1, input$case1)
LinePlotCovid(res$data,
FACET = "AgeClass", g_palette = res$col_status,
title = "Incidence per 100k, per Vac. Status / Age Class") })
The ratio between the incidence of "Unvaccinated" vs "Fully Vaccinated" over time gives us a measure of the higher risk carried by the "Unvaccinated".
DataRoll4W100kVac = DataRoll4W100k %>% filter(Status %in% grep("Fully", names(vac_levels()), value = TRUE)) %>%
select(- pop) %>% rename(ValueVac = Value) #%>% pivot_wider(names_from = Status, values_from = ValueVac)
DataRoll4W100kUnVac = DataRoll4W100k %>% filter(Status == "Unvac.") %>%
select(- Status, - pop) %>% rename(ValueUnVac = Value)
DataRoll4W100kratio <- left_join(DataRoll4W100kVac, DataRoll4W100kUnVac, by = c("AsOfDate", "AgeClass", "Case" )) %>%
mutate(Ratio = ValueUnVac / ValueVac) %>%
mutate(Ratio = ifelse(is.nan(Ratio), NA, Ratio)) %>%
mutate(Ratio = ifelse(is.infinite(Ratio), NA, Ratio)) %>%
rename(Value = Ratio)
status2 <- names(vac_levels())[grep("fully", vac_levels())]
#data2 <- DataRoll4W100kratio %>% filter(AsOfDate %in% last_timeline_weeks)
#UI
fluidRow(
column(3, offset = 1,
selectInput(inputId = "case2", label = "Hospitalizations or Deaths",
choices = c("Hospitalizations","Deaths"), selected = "Hospitalizations",
selectize = TRUE)
),
column(3,
selectInput(inputId = "status2", label = "Vac. Status",
choices = c("All",status2), selected = "All",
selectize = TRUE)
)
)
plotlyOutput("lineplot2")
#SERVER
data2 <- DataRoll4W100kratio %>% filter(AsOfDate %in% last_timeline_weeks)
output$lineplot2 <- renderPlotly({
if (is.null(input$case2))
return(plot.new())
res <- filter_dataplot(data2, input$status2, input$case2)
LinePlotCovid(res$data,
FACET = "AgeClass", g_palette = res$col_status,
title = "Cases Ratio of Unvaccinated, per Vac. Status / Age Class") })
Conclusions
The reader must be aware that the utilized data are updated by BAG every day also for the past weeks, therefore the numbers shown today may be different tomorrow. Especially the 1st line plot may show a downtrend in the last 1 or 2 weeks due to incompleteness of the latest data.
The "Unvaccinated" and "Vaccinated" populations compared in this page have some discrepancies that unfortunately cannot be handled because BAG data sources lack some views that could have been quite interesting to check:
- no data on Infections
- no info on vaccination time-lag
Other differences between the populations have been mentioned.
Even with some deficiency in the data, this analysis clearly shows the benefits of vaccination and what could have happened in Switzerland if vaccines had been unavailable. Please note that the data collection from BAG was sufficiently accurate until 2022Q2, therefore the historical comparisons of this report from 2022Q2 onwards are less meaningful.
Similar results about the benefits of vaccination are available from other countries, their dashboards or produced reports could be checked for comparison. Here a short recent list:
- Sole 24 ore{target="_blank"} analytics web page (in Italian, dashboard)
- Latest epidemiological report from RKI{target="_blank"} in Germany (in German).
- Vaccines Surveillance Report{target="_blank"} from UK Health Security Agency.
- Euro Surveillance report{target="_blank"} with comparison of many countries although with old data.
If you have any question about the approach, or any suggestion for improvement please do not hesitate to get in touch{target="_blank"}, we would love to hear from you as we may publish further updates to this article.
This page article aims also at showing how an R Markdown file can be deployed to shinyapps.io to be a live page.
For details on the architecture of the covid19vaccinationch R package that supports this deployment and its installation see the README{target="_blank"} on our public GitHub repository or read the related news post{target="_blank"} where we described it more in details.
miraisolutions/covid19-vaccination-ch documentation built on March 1, 2024, 11:15 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# store params also for server knit_params <- params
# Default code chunk setup knitr::opts_chunk$set(echo = FALSE, collapse = FALSE, comment = "") # knitr::opts_chunk$set(echo = FALSE, prompt = FALSE, collapse = FALSE) # def.chunk.hook <- knitr::knit_hooks$get("chunk") # important to fix it, as this is set dynamically by RStudio options(width = 80) load_pkg_c19 <- function(usepkgload) { if (usepkgload) { pkgload::load_all(export_all = FALSE, helpers = FALSE, attach_testthat = FALSE) } if (!("covid19vaccinationch" %in% search())) { library(covid19vaccinationch) } NULL } library(jsonlite) library(dplyr) library(tidyr) library(stringr) library(ggplot2) library(plotly) library(tidyselect) library(scales) library(htmlTable) library(lubridate) library(shiny) # # we use a font size relative to the responsive body font size (em) # # table_css <- "border-collapse: separate; border-spacing: 0.25em; width: 100%; font-size: 0.7em; margin-bottom: 14.5px;" table_cell_css <- "white-space: nowrap; font-size: .95em;" # relative to the table_css
load_pkg_c19(params$use_pkgload)
load_pkg_c19(knit_params$use_pkgload)
Since May 2020 Mirai Solutions is showing a dashboard on our gallery{target="_blank"} that contains a global view of the COVID-19 Pandemic{target="_blank"} with a further split by continent and country. We use publicly available data from the COVID-19 Data Hub{target="_blank"}, a great open source project providing a unified data set put together from numerous official local sources from all over the world.
In October and December 2021 we published 2 articles "A closer look at Vaccination breakthroughs in Switzerland"{target="_blank"} and "A 2nd look at Vaccination breakthroughs in Switzerland"{target="_blank"}, where we showed how to read data from the Swiss Federal Office for Public Health (BAG){target="_blank"} in R, and illustrated the difference in Hospitalizations and Deaths between Vaccinated and Unvaccinated during the weeks in October and December.
Here we provide a live update to these articles deployed to shinyapps.io{target="_blank"} that will always show the latest data from BAG.
Reading BAG data
To see how we read BAG data in R please refer to the previous article{target="_blank"}.
We are interested in the weekly BAG reports about vaccination breakthroughs occurred in the last 4 weeks for different age classes. See data documentation{target="_blank"} and our source: opendata.swiss{target="_blank"}.
# bag_api_url = covid19vaccinationch:::bag_api_url bag_api_url <- "https://www.covid19.admin.ch/api/data/context/"
The data documentation makes us aware of the following restrictions and warnings about the collected data:
- During the vaccination campaign the populations of "Vaccinated" and "Unvaccinated" changed, i.e. the vaccinated population has slightly increased.
- Many infected people have "Unknown" vaccination status, therefore this source has been disabled by BAG, while a more complete information is available for Hospitalized and Deaths cases.
To solve the former problem (1.) we will use the average of the "Vaccinated" an "Unvaccinated" population sizes across the month.
if (params$fetch_latest_data) { message("** reading Vac data from Source **") DATA = read_bag_data_vac(bag_api_url, ageclassMap) } else { # read from RDS DATA <- readRDS(file.path(data_path(), "DATA.rds")) } # aggregation to new age classes DATA.AGG = DATA %>% group_by(Week,AgeClass, vaccination_status ) %>% summarise_if(is.numeric, sum, na.rm = TRUE) weeks4 = tail(unique(DATA.AGG$Week), 4) period = paste(range(weeks4), collapse = "-") DATA.AG4W <- DATA.AGG %>% filter(Week %in% weeks4) # read Cases, from RDS if (params$fetch_latest_data) { message("** reading Infection data from Source **") CASES = read_bag_data_cases(bag_api_url, ageclassMap, dateweek = unique(DATA$Week)) } else { # read from RDS CASES <- readRDS(file.path(data_path(), "CASES.rds")) } CASES.AGG = CASES %>% group_by(Week,AgeClass ) %>% summarise_if(is.numeric, sum, na.rm = TRUE) CASES.AG4W <- CASES.AGG %>% filter(Week %in% weeks4) weeks_from_to <- weeks_to_date(weeks4, range = TRUE) periodLabel = paste("(", paste(weeks_from_to, collapse = ","),")", sep = "")
As of Today (r Sys.Date()) the 4 last weeks considered are: r weeks4 (YY-W-Week Number), i.e. in the interval from r weeks_from_to[1] to r weeks_from_to[2].
The age categories have been redefined again as: r unique(ageclassMap$AgeClass).
Last 4 weeks Cases and Vaccination
aggrvars = names(DATA.AG4W) [sapply(DATA.AG4W, is.numeric)] %>% grep(pattern = "_tot$", value = TRUE, invert = TRUE) %>% grep(pattern = "^pop", value = TRUE, invert = TRUE) cumvars = setdiff(names(DATA.AG4W)[sapply(DATA.AG4W, is.numeric)], aggrvars) # Aggregate to last month figures DATA.AG1M <- aggregate_to_month(DATA.AG4W, period, aggv = aggrvars, cumv = cumvars) CASES.AG1M <- aggregate_to_month(CASES.AG4W, period, by = "AgeClass", aggv = "confirmed", cumv = c("pop", "confirmed_tot")) # prepare data for Cases plot datacases <- DATA.AG1M %>% select(Week, AgeClass, deaths, hosp, vaccination_status, pop) %>% group_by(Week, AgeClass) %>% # remove vaccination summarize(across(where(is.numeric), sum)) %>% ungroup() %>% # merge with cases left_join(CASES.AG1M %>% select(-pop,-confirmed_tot), by = c("Week", "AgeClass")) # assign unknown Age Class to all datacases$confirmed[datacases$AgeClass == "All"] = datacases$confirmed[datacases$AgeClass == "All"] + datacases$confirmed[datacases$AgeClass == "unknown"] datacases$hosp[datacases$AgeClass == "All"] = datacases$hosp[datacases$AgeClass == "All"] + datacases$hosp[datacases$AgeClass == "unknown"] datacases$deaths[datacases$AgeClass == "All"] = datacases$deaths[datacases$AgeClass == "All"] + datacases$deaths[datacases$AgeClass == "unknown"] datacases <- datacases %>% filter(!AgeClass %in% c("unknown")) %>% rename(AsOfDate = Week) %>% bind_cols() %>% pivot_longer(cols = c("confirmed", "deaths", "hosp"), names_to = "Case", values_to = "Value") %>% mutate(Case = factor(Case, levels = c("confirmed", "hosp", "deaths"), labels = c("Infections", "Hospitalizations", "Deaths")))
.extract_value <- function(data, case, age = "All", val = "Value") { data %>% filter(AgeClass %in% age & Case == case) %>% as.data.frame() %>% .[, val] %>% formatC(format = "f", big.mark = "'", digits = 0) }
The current situation of the last 4 weeks as of r weeks_from_to[2], i.e. how the infections, hospitalizations and deaths occurred across the age classes in absolute terms is shown below. Overall during this period Switzerland has registered r .extract_value(datacases, "Infections") infections, r .extract_value(datacases, "Hospitalizations") hospitalizations and r .extract_value(datacases, "Deaths") deaths.
datacasesAges = datacases %>% filter(!AgeClass %in% c("All")) plotcol <- pick_vac_lev_col("not_vaccinated") BarplotCovid(datacasesAges, g_palette = plotcol, X = "AgeClass", FACET = "Case", percent = FALSE)
To account for different distribution of the population in the Age Classes consider the Incidence over 100'000 inhabitants:
datacases100k = datacases %>% mutate(Value = Value / pop * 100000) # plotcol <- c(rep(pick_vac_lev_col("not_vaccinated"), length(unique(ageclassMap$AgeClass))), "firebrick4") plotcol <- pick_vac_lev_col("not_vaccinated") BarplotCovid(datacases100k, g_palette = plotcol, X = "AgeClass", FACET = "Case", percent = FALSE)
Infections happen more frequently in younger age classes (at least in absolute terms) while Hospitalizations and Deaths are more common among the older ones.
Current Vaccination Status
The current vaccination status per age group as of r weeks_from_to[2] is shown below. The "Fully Vaccinated" population is split according to the occurred injection of the Booster dose.
Pop <- DATA.AG1M %>% filter((!AgeClass %in% c("unknown"))) %>% select(-Week) %>% group_by(AgeClass) %>% summarize(pop = sum(pop)) %>% mutate(AsOfDate = unique(DATA.AG1M$Week)) %>% ungroup() datavacc <- DATA.AG1M %>% select(Week, AgeClass,pop, vaccination_status) %>% filter((!vaccination_status %in% c("Unknown","Unvac.")) & (!AgeClass %in% c("unknown"))) %>% mutate(Status = factor(vaccination_status, levels = rev(names(vac_levels())[c(-1,-length(vac_levels()))]))) %>% rename(AsOfDate = Week, Value = pop) %>% left_join(Pop, by = c("AsOfDate", "AgeClass")) %>% mutate(Vax = Value ) %>% mutate(Value = Vax / pop) %>% select(-vaccination_status) datavacall <- datavacc %>% filter(AgeClass == "All") %>% #arrange(!!sym(FILL)) %>% mutate(Value = cumsum(Value)) %>% ungroup() %>% mutate(Value = .funformat(Value * 100, TRUE), Vax = .funformat(Vax, FALSE))
plotcol <- pick_vac_lev_col(c("partially_vaccinated", "fully_vaccinated_no_booster", "fully_vaccinated_first_booster")) StackedBarplotCovid(datavacc, g_palette = c(plotcol), X = "AgeClass", FILL = "Status", position = "stack", title = "Vaccination Status per age", percent = TRUE)
r datavacall %>% filter(Status %in% names(vac_levels())[vac_levels() == "fully_vaccinated_no_booster"]) %>% .[,"Value"] of the Swiss population is fully vaccinated (2 doses), r datavacall %>% filter(Status %in% names(vac_levels())[vac_levels() == "partially_vaccinated"]) %>% .[,"Value"] has received at least one dose, while r datavacall %>% filter(Status %in% names(vac_levels())[vac_levels() == "fully_vaccinated_first_booster"]) %>% .[,"Value"] has received the booster dose.
When making a comparison between the Vaccinated and Unvaccinated it is worth first highlighting the differences between the 2 populations that would bias such comparison.
The biggest difference is the younger age of the "Unvaccinated" population, less likely to be impacted by Covid-19. For this reason the data are grouped in Age Classes, even within the same class, there can be are other differences to consider that may make a population more or less inclined to infection, and hence to hospitalizations. Measures in the Age Class "All" have to be age-adjusted.
Further bias is introduced by the fact that "Unvaccinated" may have recovered from Covid and therefore have a protection. Unfortunately we cannot extract relevant information from BAG that would allow us to exclude the already Infected from the "Unvaccinated" population. We can show here the % of total contagion in the global population and warn the readers that a "small" % of the "Unvaccinated" is NOT unprotected (leading to underestimation of the positive effect of vaccination).
TotConfirmed <- CASES.AG1M %>% filter(AgeClass != "unknown") %>% select(AgeClass,confirmed_tot, pop) TotConfirmed <- TotConfirmed %>% mutate(Percentage = confirmed_tot / pop * 100) %>% rename(Population = pop, Infections = confirmed_tot) %>% pivot_longer(cols = c("Population", "Infections", "Percentage"), names_to = "Case", values_to = "Value") %>% mutate(Case = factor(Case, levels = c("Population", "Infections", "Percentage"), labels = c("Population", "Infections", "Percentage"))) %>% rename(value = Value) TotConfirmed %>% mutate(value = ifelse(value < 100, paste(round(value, 1), "%"), # simplified formatC(round(value), format = "f", big.mark = "'", digits = 0))) %>% addHtmlTableStyle( align = "c", css.table = sub(" *margin-bottom.*?;", "", table_css), css.cell = color_cells(TotConfirmed, header = "Case", rnames = "AgeClass", table_cell_css = table_cell_css) ) %>% tidyHtmlTable(header = Case , #cgroup = c(Case), rnames = AgeClass, caption = paste("Table 1: Confirmed Infections per Age Class.", weeks_from_to[2]))
It is worth mentioning other possible sources of bias that can't be isolated, some of these differences could actually cause a bias in both directions.
- Leading to underestimation of vaccination effect:
- People with chronic diseases are over-represented in the "Vaccinated" population (visible from BAG website).
- During 3G-2G rule (green pass) the "Unvaccinated" have been less present in risky locations
- Hospitalized "with" Covid, i.e. recorded positive upon hospitalization, are counted as Covid patients, despite they are not in hospital because of Covid.
We are happy to hear more from the readers about this topic and possibly collect sources that could give a better insight. We can neglect of course possible causes of bias for Infections (e.g. lower test tendency of the "Vaccinated") that would not lead to a possible hospitalization, as Infections are not treated in this article.
Last 4 weeks vaccination breakthrough cases
UPDATE 2022-11: as it can be seen from the large numbers in the Unknown catefory, BAG does not keep track properly any more of the vaccination status.
A view of the absolute figures of all vaccination categories, including "Unknown", i.e. not reported.
DataPlot <- DATA.AG1M %>% select(Week, AgeClass, vaccination_status, hosp, deaths, pop) %>% filter(!AgeClass %in% c("unknown")) %>% rename(AsOfDate = Week, population = pop) %>% bind_cols() %>% pivot_longer(cols = c("population","hosp", "deaths"), names_to = "Case", values_to = "Value") %>% mutate(Case = factor(Case, levels = c("population","hosp","deaths"), labels = c("Population", "Hospitalizations", "Deaths"))) DataTab <- DataPlot %>% rename(Status = vaccination_status) %>% rename(value = Value)
.calc_perc_unknwon <- function(data, case) { perc <- (data %>% filter(Case == case & vaccination_status == "Unknown" & AgeClass == "All") %>% .[,"Value"] / data %>% filter(Case == case & AgeClass == "All") %>% summarize(totcases = sum(Value)) %>% .[, "totcases"]) %>% as.data.frame() %>% .[, "Value"] paste(round(perc * 100,1), "%") } DataPlotTab1 <- DataPlot %>% #filter(AgeClass != "All") %>% rename(Status = "vaccination_status") StackedBarplotCovid(DataPlotTab1, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(vac_levels_colors()), position = "fill", title = "Vaccinated vs Unvaccinated Cases")
Overall the vaccination status is "Unknown" for r .calc_perc_unknwon(DataPlot, "Hospitalizations") of the Hospitalized and for r .calc_perc_unknwon(DataPlot, "Deaths") of the Deaths.
# DataTab = DataPlot %>% # rename(Status = vaccination_status) %>% # rename(value = Value) DataTab %>% filter(!Case %in% c("Infections")) %>% select(-AsOfDate) %>% mutate(value = formatC(round(value), format = "f", big.mark = "'", digits = 0)) %>% addHtmlTableStyle( align = "c", css.table = sub(" *margin-bottom.*?;", "", table_css), css.cell = color_cells(DataTab %>% filter(!Case %in% c("Infections")) %>% select(-AsOfDate), header = "Status", cgroup = "Case", rnames = "AgeClass", table_cell_css = table_cell_css) ) %>% tidyHtmlTable(header = Status , cgroup = c(Case), rnames = AgeClass, caption = paste("Table 2: absolute entries per age and vaccination status.", periodLabel))
There is no hint of whether the "Unknown" entries tend to be more or less vaccinated (checking their curves in the BAG site they seem to be somewhere in between), therefore it can make sense to reassign proportionally these cases to the others vaccination categories.
#Allocate Unknown to the other cats DataTabScale <- rescale_unknown(DataTab)
DataTabScale %>% mutate(value = formatC(round(value), format = "f", big.mark = "'", digits = 0)) %>% mutate(value = ifelse(value == "NaN", "", value)) %>% select(-AsOfDate) %>% addHtmlTableStyle( align = "c", css.table = table_css, css.cell = color_cells(DataTabScale %>% select(-1), header = "Status" , cgroup = "Case", rnames = "AgeClass") ) %>% tidyHtmlTable(header = Status , cgroup = Case, rnames = AgeClass, caption = paste("Table 3: entries per age and vaccination status. Reallocation of Unknown vaccination status.", periodLabel))
After this reallocation let's look at the records over 100'000 people in each reference Age Class and vaccination status, and at the ratio between the "Unvaccinated" and "Vaccinated" cases. This view will be used also in the following sections. When accounting for the total, i.e. "All" Age Class, age adjusted figures have been computed accounting for the different distribution of the "Vaccinated" and "Unvaccinated" groups across the different Age Classes.
# scale to 100k DataPlot100kScale <- make_100k(DataTabScale %>% rename(Value = value), by = c("AsOfDate","AgeClass", "Status"), status = "Status") DataPlot100kScale2 = DataPlot100kScale %>% filter( Case != "Population") StackedBarplotCovid(DataPlot100kScale2, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(vac_levels_colors()[-1]), position = "fill", title = "Vaccinated vs Unvaccinated Cases per 100'000 people")
The ratio of the impact per 100'000 people of the "Fully Vaccinated" vs the "Unvaccinated" measures the vaccination effect and the risk of Hospitalization or Death of the "Unvaccinated" versus the "Vaccinated".
DataPlot100kScaleRatios <- calc_ratio_fullyvac(DataPlot100kScale) %>% filter(Status %in% names(vac_levels())[grep("fully", vac_levels())]) DataPlot100kScaleRatiosPlot = DataPlot100kScaleRatios %>% filter(Variable == "Ratio over Unvac.") %>% rename(Value = value) plotcol <- pick_vac_lev_col(c("fully_vaccinated_first_booster", "fully_vaccinated_no_booster")) StackedBarplotCovid(DataPlot100kScaleRatiosPlot %>% select(-Variable) , g_palette = c(plotcol), X = "AgeClass", FILL = "Status", FACET = "Case", percent = FALSE, title = "Ratio of Unvac. Impact vs Fully Vac", position = "dodge")
DataPlot100kScaleRatios %>% mutate(value = replace_na(as.character(value), "")) %>% addHtmlTableStyle( align = "c", css.table = table_css, css.cell = color_cells(DataPlot100kScaleRatios %>% select(-pop, -AsOfDate), header = "Status" , cgroup = c("Case","Variable"), rnames = "AgeClass", table_cell_css = table_cell_css) ) %>% tidyHtmlTable(header = Status , cgroup = c(Case,Variable), rnames = AgeClass, caption = paste("Table 4: entries over 100'000 people per age and vaccination status. Reallocation of Unknown vaccination status.", periodLabel), skip_removal_warning = TRUE)
The estimate indicate that the "Unvaccinated" people have r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_first_booster") & grepl("Ratio", Variable) & Case == "Hospitalizations") %>% as.data.frame() %>% .[,"value"] times higher risk to be hospitalized, r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_first_booster") & grepl("Ratio", Variable) & Case == "Deaths") %>% as.data.frame() %>% .[,"value"] times higher risk to die compared with a "Fully Vaccinated with Booster", while r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_no_booster") & grepl("Ratio", Variable) & Case == "Hospitalizations") %>% as.data.frame() %>% .[,"value"] and r DataPlot100kScaleRatios %>% filter(AgeClass == "All" & Status == pick_vac_lev("fully_vaccinated_no_booster") & grepl("Ratio", Variable) & Case == "Deaths") %>% as.data.frame() %>% .[,"value"] times higher compared with "Fully Vaccinated without Booster".
Scenario Analysis
Assuming there are 3 possible Scenarios to add to the current one: what if there had been no vaccinated at all this month? Or if we had been all vaccinated? What if all with Booster?
These opposite scenarios can be generated and compared with what really happened in the last 4 weeks ("Current") by taking the Hospitalization and Death rates over 100'000 people of the unvaccinated ("No Vac.") and vaccinated ("Vac. Booster" / "Vac No Booster") populations and projecting them over the full population.
Worth mentioning that the protection given by the vaccines against infection is also to consider as source of bias in this scenario analysis:
- If there was no vaccination at all the "Unvaccinated" would have worse figures, as they would not benefit of the presence of a vaccinated population and they would have more infections.
- On the contrary, there would be fewer cases among the "Vaccinated" (and hence hospitalizations and deaths) if the whole population had received a full protection.
Despite the decay of vaccination benefits over time and against infections (Omicron), this is still a factor to consider.
The Incidence over 100'000 people in the 3 scenarios + "Current" are presented below:
datacases100k = datacases100k %>% mutate(Status = "current") DataPlot100kp = DataPlot100kScale %>% filter(Status %in% names(vac_levels()[c(5,3,2)])) %>% bind_rows(datacases100k) %>% mutate(Status = factor(Status, levels = c("Unvac.","current",names(vac_levels()[c(3,2)])), labels = c("No Vac.","Current", "Vac. No Booster", "Vac. Booster"))) %>% filter(Case %in% c("Hospitalizations","Deaths")) %>% arrange(AgeClass,Status,Case) plotcol <- c(pick_vac_lev_col(c("not_vaccinated")), col_current_status(), pick_vac_lev_col(c("fully_vaccinated_no_booster", "fully_vaccinated_first_booster"))) StackedBarplotCovid(DataPlot100kp, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(plotcol), position = "dodge", title = "Hosp. and Deaths per 100k for each scenarios")
More importantly, projecting the values of the 3 scenarios on the whole population we can evaluate the vaccination impact in absolute terms.
DataPlotp = DataPlot100kp %>% select(-pop) %>% left_join(Pop, by = c(c("AsOfDate", "AgeClass"))) %>% mutate(Value = round(Value*pop / 100000)) DataPlotpTab7 = DataPlotp %>% filter(AgeClass != "All") plotcol <- c(pick_vac_lev_col(c("not_vaccinated")), col_current_status(), pick_vac_lev_col(c("fully_vaccinated_no_booster", "fully_vaccinated_first_booster"))) StackedBarplotCovid(DataPlotpTab7, X = "AgeClass", FILL = "Status", FACET = "Case", g_palette = c(plotcol), position = "dodge", title = "Hosp. and Deaths for each scenarios")
DataTabp <- DataPlotp %>% select(-pop, AsOfDate) %>% rename(value = Value) DataTabp %>% addHtmlTableStyle( align = "c", css.table = table_css, css.cell = color_cells(DataTabp %>% select(-1), header = "Status" , cgroup = "Case", rnames = "AgeClass", table_cell_css = table_cell_css#, skip = "Total" ) ) %>% tidyHtmlTable(header = Status, cgroup = Case, rnames = AgeClass, caption = paste("Table 5: Scenarios per age and vaccination status. Reallocation of Unknown vaccination status.", periodLabel), skip_removal_warning = TRUE)
If there had been no vaccination at all, in the last 4 weeks there would have been r DataTabp %>% filter(AgeClass == "All" & Status == "No Vac." & Case == "Hospitalizations") %>% as.data.frame() %>% .[,"value"] %>% .funformat(FALSE) Hospitalizations and r DataTabp %>% filter(AgeClass == "All" & Status == "No Vac." & Case == "Deaths") %>% .[,"value"] %>% .funformat(FALSE) Deaths, on the contrary, if all had received booster, there would have been r DataTabp %>% filter(AgeClass == "All" & Status == "Vac. Booster" & Case == "Hospitalizations") %>% .[,"value"] %>% .funformat(FALSE) Hospitalizations and r DataTabp %>% filter(AgeClass == "All" & Status == "Vac. Booster" & Case == "Deaths") %>% .[,"value"] %>% .funformat(FALSE) Deaths.
Time line of reported case
This section reports how the cases developed over time within the 3 populations. Please note, differentiating according to the actual date of vaccination (e.g. if earlier than or within 6 months) is not possible.
Figures per 100'000 people are shown again, reallocating those in the "Unknown" category in each analyzed week.
ageclasses2 <- sort(unique(ageclassMap$AgeClass2)) DataRoll4W100k <- readRDS(file.path(data_path(), "DataRoll4W100k.rds")) %>% filter(Status != "Partially vac.") # remove partial vac #last_timeline_weeks <- tail(unique(DataRoll4W100k$AsOfDate), 40) last_timeline_weeks <- unique(DataRoll4W100k$AsOfDate) # zero out data for booster prior to reaching 10% boosted threshold.vax = 0.2 first.week.vac <- DataRoll4W100k %>% filter(AgeClass == "All", Status == "Fully vac. No Booster", Case == "Deaths") %>% select(AsOfDate, pop) %>% left_join(DataRoll4W100k %>% filter(AgeClass == "All") %>% group_by(AsOfDate) %>% summarise(sumpop = sum(pop)), by = "AsOfDate") %>% mutate(VaxPop = pop/sumpop) %>% filter(VaxPop > threshold.vax) %>% .[1, "AsOfDate"] last_timeline_weeks <- unique(DataRoll4W100k$AsOfDate[DataRoll4W100k$AsOfDate >= as.character(first.week.vac)]) threshold.boostervax = 0.1 first.week.booster <- DataRoll4W100k %>% filter(AgeClass == "All", Status == "Fully vac. Booster", Case == "Deaths") %>% select(AsOfDate, pop) %>% left_join(DataRoll4W100k %>% filter(AgeClass == "All") %>% group_by(AsOfDate) %>% summarise(sumpop = sum(pop)), by = "AsOfDate") %>% mutate(VaxPop = pop/sumpop) %>% filter(VaxPop > threshold.boostervax) %>% .[1, "AsOfDate"] # override values for booster DataRoll4W100k <- DataRoll4W100k %>% mutate(Value = ifelse(Status == "Fully vac. Booster" & AsOfDate < as.character(first.week.booster), NA, Value))
The "Partially Vaccinated" population has been removed while the Booster status is shown only since r first.week.booster[1] (r weeks_to_date(as.character(first.week.booster[1]), range = FALSE)), i.e. when Booster doses had been administered to at least r paste0(threshold.boostervax[1]*100, "%") of the population. In order to include more data also during low-waves periods the age Classes are restricted to 4: r ageclasses2. We also reduce the time-line to start from week r last_timeline_weeks[1], corresponding to the date r weeks_to_date(last_timeline_weeks[1], range = FALSE) when at least r paste0(threshold.vax[1]*100, "%") of the population was fully vaccinated.
In this part the calculations done so far are replicated for each week in the time-line, i.e. for a given week the report's figures related to its past 4 weeks are being recalculated. In this way the lines can appear smoother and make the estimates more reliable (at least for over 40 where there are enough data).
The graph below shows the incidence over 100'000 people for each Age and Vaccination class, choose between Hospitalized or Deaths cases and their Vaccination Status.
status1 <- names(vac_levels())[grep("fully_vaccinated|not_vaccinated", vac_levels())] #data1 <- DataRoll4W100k %>% filter(AsOfDate %in% last_timeline_weeks) #UI fluidRow( column(3, offset = 1, selectInput(inputId = "case1", label = "Hospitalizations or Deaths", choices = c("Hospitalizations","Deaths"), selected = "Hospitalizations", selectize = TRUE) ), column(3, selectInput(inputId = "status1", label = "Vac. Status", choices = c("All",status1), selected = "All", selectize = TRUE) ) ) plotlyOutput("lineplot1")
#SERVER data1 <- DataRoll4W100k %>% filter(AsOfDate %in% last_timeline_weeks) output$lineplot1 <- renderPlotly({ if (is.null(input$case1)) return(plot.new()) res <- filter_dataplot(data1, input$status1, input$case1) LinePlotCovid(res$data, FACET = "AgeClass", g_palette = res$col_status, title = "Incidence per 100k, per Vac. Status / Age Class") })
The ratio between the incidence of "Unvaccinated" vs "Fully Vaccinated" over time gives us a measure of the higher risk carried by the "Unvaccinated".
DataRoll4W100kVac = DataRoll4W100k %>% filter(Status %in% grep("Fully", names(vac_levels()), value = TRUE)) %>% select(- pop) %>% rename(ValueVac = Value) #%>% pivot_wider(names_from = Status, values_from = ValueVac) DataRoll4W100kUnVac = DataRoll4W100k %>% filter(Status == "Unvac.") %>% select(- Status, - pop) %>% rename(ValueUnVac = Value) DataRoll4W100kratio <- left_join(DataRoll4W100kVac, DataRoll4W100kUnVac, by = c("AsOfDate", "AgeClass", "Case" )) %>% mutate(Ratio = ValueUnVac / ValueVac) %>% mutate(Ratio = ifelse(is.nan(Ratio), NA, Ratio)) %>% mutate(Ratio = ifelse(is.infinite(Ratio), NA, Ratio)) %>% rename(Value = Ratio)
status2 <- names(vac_levels())[grep("fully", vac_levels())] #data2 <- DataRoll4W100kratio %>% filter(AsOfDate %in% last_timeline_weeks) #UI fluidRow( column(3, offset = 1, selectInput(inputId = "case2", label = "Hospitalizations or Deaths", choices = c("Hospitalizations","Deaths"), selected = "Hospitalizations", selectize = TRUE) ), column(3, selectInput(inputId = "status2", label = "Vac. Status", choices = c("All",status2), selected = "All", selectize = TRUE) ) ) plotlyOutput("lineplot2")
#SERVER data2 <- DataRoll4W100kratio %>% filter(AsOfDate %in% last_timeline_weeks) output$lineplot2 <- renderPlotly({ if (is.null(input$case2)) return(plot.new()) res <- filter_dataplot(data2, input$status2, input$case2) LinePlotCovid(res$data, FACET = "AgeClass", g_palette = res$col_status, title = "Cases Ratio of Unvaccinated, per Vac. Status / Age Class") })
Conclusions
The reader must be aware that the utilized data are updated by BAG every day also for the past weeks, therefore the numbers shown today may be different tomorrow. Especially the 1st line plot may show a downtrend in the last 1 or 2 weeks due to incompleteness of the latest data.
The "Unvaccinated" and "Vaccinated" populations compared in this page have some discrepancies that unfortunately cannot be handled because BAG data sources lack some views that could have been quite interesting to check:
- no data on Infections
- no info on vaccination time-lag
Other differences between the populations have been mentioned.
Even with some deficiency in the data, this analysis clearly shows the benefits of vaccination and what could have happened in Switzerland if vaccines had been unavailable. Please note that the data collection from BAG was sufficiently accurate until 2022Q2, therefore the historical comparisons of this report from 2022Q2 onwards are less meaningful.
Similar results about the benefits of vaccination are available from other countries, their dashboards or produced reports could be checked for comparison. Here a short recent list:
- Sole 24 ore{target="_blank"} analytics web page (in Italian, dashboard)
- Latest epidemiological report from RKI{target="_blank"} in Germany (in German).
- Vaccines Surveillance Report{target="_blank"} from UK Health Security Agency.
- Euro Surveillance report{target="_blank"} with comparison of many countries although with old data.
If you have any question about the approach, or any suggestion for improvement please do not hesitate to get in touch{target="_blank"}, we would love to hear from you as we may publish further updates to this article.
This page article aims also at showing how an R Markdown file can be deployed to shinyapps.io to be a live page. For details on the architecture of the covid19vaccinationch R package that supports this deployment and its installation see the README{target="_blank"} on our public GitHub repository or read the related news post{target="_blank"} where we described it more in details.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.