In mrc-ide/squire.page: Functions used in global-lmic-reports-orderly and other repos
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
library(tidyr)
library(dplyr)
library(ggplot2)
library(squire.page)
This vignette describes the rewritten nimue booster pathway. This update
allows the inclusion of booster doses to vaccination campaigns in the nimue
model and allows explicit inclusion of first and second dose efficacies. No changes are
made to the infection and hospitalisation pathway.
Model Structure
knitr::include_graphics("./Nimue_Booster_Diagram.png")
Compartment definitions are as follows:
- $uV$ Un-vaccinated population,
- $pV_i$ Partially vaccinated/protected population (i.e. first dose of a two dose regimen),
- $fV_i$ Fully vaccinated/protected population (i.e. both doses of a two dose regimen).
- $bV_i$ Boosted population (at least one booster dose).
Full dose and boosted compartments both feed into waned compartments that
represent reduced vaccine efficacy over time. Transition rates are defined as:
- $fD_t$ Daily time-series of first doses,
- $sD_t$ An inferred delay between doses (~60 days),
- $bD_{1,t}$ Daily time-series of initial booster doses,
- $bD_{2,t}$ Daily time-series of follow-up booster doses, can be limited to certain age groups,
- $w_p$ Rate of waning of initial dose protection,
- $w_i$ Rate of waning of boosted dose protection.
Eligibility for follow-up boosters can be restricted to certain age groups with
the parameter vaccine_booster_follow_up_coverage.
Usage
The user is expected to provide a time-series of primary doses, and booster doses.
This model is primarily for usage in the global_lmic_reports, and so it not
intended for normal usage. The objects necessary for MCMC fitting can be access
as so:
#model object
squire.page::nimue_booster_model()
#likelihood function
squire.page::calc_loglikelihood_booster()
#pmcmc object
squire.page::pmcmc_drjacoby(log_likelihood = squire.page::calc_loglikelihood_booster,
nimue_booster_model = squire.page::nimue_booster_model,
... #specific arguments here
)
#alternatively
rt_optimise(squire_model = squire.page::nimue_booster_model(),
... #Parameter arguments here
)
The model can be run as in squire or nimue with the non-exported function
squire.page:::run_booster.
squire.page:::run_booster(
country = "United Kingdom",
primary_doses = c(100, 1000, 500, 0),
tt_primary_doses = c(0, 10, 50, 150),
second_dose_delay = 60,
booster_doses = c(0, 500, 750),
tt_booster_doses = c(0, 200, 400),
time_period = 365*2,
vaccine_booster_follow_up_coverage = c(rep(0, 17 - 5), rep(1, 5))
) %>%
squire.page::nimue_format(var_select = c("vaccinated_first_dose", "vaccinated_second_dose", "vaccinated_second_waned",
"vaccinated_booster_dose", "vaccinated_booster_waned")) %>%
tibble() %>%
pivot_wider(names_from = compartment, values_from = y) %>%
transmute(
t = t,
`Partial` = vaccinated_first_dose - vaccinated_second_dose,
`Primary` = vaccinated_second_dose - vaccinated_booster_dose - vaccinated_second_waned,
`Waned (Primary)` = vaccinated_second_waned,
`Boosted` = vaccinated_booster_dose - vaccinated_booster_waned,
`Waned (Boosted)` = vaccinated_booster_waned
) %>%
pivot_longer(c(`Partial`, `Primary`,
`Waned (Primary)`,
`Boosted`,
`Waned (Boosted)`),
names_to = "Vaccine Protection", values_to = "Population") %>%
ggplot(aes(x = t, y = `Population`, colour = `Vaccine Protection`)) +
geom_line()
As the delay in development of vaccination protection from nimue is removed, the time-series
for first/second doses provided to the model if internally adjusted via an Erlang
distribution with shape 2 and rate 1/7 to simulate this effect. These parameters
are customizable in the model.
To simulate a primary single dose vaccine (i.e. Janssen) set both first and second
dose efficacies to the same desired level and set the second dose delay to 1.
Parameterisation
Default parameter values are chosen to be representative for the vaccination
programmes of LMIC and LIC countries and against the wild-type variant and as
such represent no single vaccine but are chosen from a range of values to
represent roughly the Adenovirus, Whole Virus, and Subunit vaccines.
Note that for work involving these efficacies against Delta and Omicron are
calculated elsewhere.
Vaccine Efficacies:
tribble(
~`Compartment`, ~`Protection Against Hospitalisation`, ~`Protection Against Infection`,
"~pV~", 0.444, 0.55,
"~fV_1~", 0.856, 0.942,
"~fV_2~", 0.755, 0.339,
"~fV_3~", 0.265, 0.000,
"~bV_1~", 0.848, 0.923,
"~bV_2~", 0.768, 0.358,
"~bV_3~", 0.287, 0.000
) %>%
knitr::kable()
Waning Rates:
- $w_{f,1}$ = 0.014000362 (71.4 days)
- $w_{f,2}$ = 0.001162850 (860.0 days)
- $w_{b,1}$ = 0.009689185 (103.2 days)
- $w_{b,2}$ = 0.000913242 (1094 days)
Delay in second dose protection is assumed to be 60 days. Note that VE against hospitalisation is scaled for break through infections.
See inst/misc/fit_ve_curve.r for the code used to fit these curves.
To calculate these values we utilised an approach taken previously with waning
vaccine efficacy via AB titres (Report 48). We took our assumed
non-waned efficacies and then created an median waning curve from these values.
Then we fit the waning rates and waned compartment values to recreate these curves.
The plots of these fits are shown below.
knitr::include_graphics("./fitted_value_plot.png")
Comparison to nimue
Comparing the two models in the absence of vaccinations should give identical
results, outside of minor variations due to the random ages of the initial infections.
t <- 700
dur_R <- 365
booster_df <- squire.page:::run_booster(
country = "United Kingdom",
primary_doses = 0,
tt_primary_doses = 0,
second_dose_delay = 1,
booster_doses = 0,
tt_booster_doses = 0,
time_period = t,
vaccine_booster_follow_up_coverage = rep(0, 17),
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
nimue_df <- nimue::run(
country = "United Kingdom",
max_vaccine = 0,
tt_vaccine = 0,
time_period = t,
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
rbind(
booster_df %>%
mutate(
Model = "Booster"
), nimue_df %>%
mutate(Model = "Nimue")
) %>%
mutate(compartment = stringr::str_to_title(compartment)) %>%
ggplot() +
geom_line(aes(x = t, y = y, colour = Model), linewidth = 1, alpha = 0.5) +
facet_wrap(vars(compartment), scales = "free", strip.position = "left") +
labs(y = "", title = "No Vaccinations")
Comparing the two models with only primary doses (with a flat efficacy for first/second)
and no waning should also be identical
t_old <- t
t <- 200
booster_df <- squire.page:::run_booster(
country = "United Kingdom",
primary_doses = 100000,
tt_primary_doses = 0,
second_dose_delay = 1,
booster_doses = 0,
tt_booster_doses = 0,
time_period = t,
vaccine_booster_follow_up_coverage = rep(0, 17),
vaccine_efficacy_infection = rep(0.5, 7),
vaccine_efficacy_disease = rep(0.5, 7),
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = matrix(
rep(0.5, 7), ncol = 17, nrow = 7
),
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
nimue_df <- nimue::run(
country = "United Kingdom",
max_vaccine = 100000,
tt_vaccine = 0,
time_period = t,
vaccine_efficacy_infection = 0.5,
vaccine_efficacy_disease = 0.5,
dur_V = Inf,
dur_vaccine_delay = 14,
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = 0.5,
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
rbind(
booster_df %>%
mutate(
Model = "Booster"
), nimue_df %>%
mutate(Model = "Nimue")
) %>%
mutate(compartment = stringr::str_to_title(compartment)) %>%
ggplot() +
geom_line(aes(x = t, y = y, colour = Model), linewidth = 1, alpha = 0.5) +
facet_wrap(vars(compartment), scales = "free", strip.position = "left") +
labs(y = "", title = "Single dose no waning")
t <- t_old
With waning we would expect to see almost no difference.
booster_df <- squire.page:::run_booster(
country = "United Kingdom",
primary_doses = 100000,
tt_primary_doses = 0,
second_dose_delay = 0,
booster_doses = 0,
tt_booster_doses = 0,
time_period = t,
vaccine_booster_follow_up_coverage = rep(0, 17),
vaccine_efficacy_infection = c(0.5, 0.5, 0.5, 0, 0, 0, 0),
vaccine_efficacy_disease = c(0.5, 0.5, 0.5, 0, 0, 0, 0),
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = matrix(
c(0.5, 0.5, 0.5, 1, 1, 1, 1), ncol = 17, nrow = 7,
),
dur_V = rep(50, 4),
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
nimue_df <- nimue::run(
country = "United Kingdom",
max_vaccine = 100000,
tt_vaccine = 0,
time_period = t,
vaccine_efficacy_infection = 0.5,
vaccine_efficacy_disease = 0.5,
dur_V = 100 + 14,
dur_vaccine_delay = 14,
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = 0.5,
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
rbind(
booster_df %>%
mutate(
Model = "Booster"
), nimue_df %>%
mutate(Model = "Nimue")
) %>%
mutate(compartment = stringr::str_to_title(compartment)) %>%
ggplot() +
geom_line(aes(x = t, y = y, colour = Model), size = 1, alpha = 0.5) +
facet_wrap(vars(compartment), scales = "free", strip.position = "left") +
labs(y = "", title = "Single dose with waning")
In the plot above we increase the duration of waning in nimue by 14 days to account
for the fact that in the booster model the 14 day delay in developing VE is applied
for both first and second doses. Otherwise the second peak occurs a couple of days sooner in nimue.
To simulate two doses we first consider the situation with a delay of 60 days between
the two, for nimue this is translated into a dose ratio and the VE are scaled. Again for
nimue we must increase the duration of protection to account for the delay between doses.
dose_delay <- 60
ve_i_f <- 0.25
ve_i_s <- 0.75
ve_d_f <- 0.25
ve_d_s <- 0.75
primary_doses <- 100000
eligible_pop <- sum(squire::population$n[squire::population$iso3c == "GBR"])*0.8
#will hit saturation
curr_first <- cumsum(rep(primary_doses, floor(eligible_pop/primary_doses)))
curr_first <- c(curr_first, rep(eligible_pop, t - length(curr_first)))
curr_second <- c(rep(0, dose_delay), head(curr_first, length(curr_first) - dose_delay))
dose_ratio <- curr_second/curr_first
ve_i_nimue <- ve_i_f * (1 - dose_ratio) + ve_i_s * dose_ratio
ve_d_nimue <- ve_d_f * (1 - dose_ratio) + ve_d_s * dose_ratio
tt_vaccine <- seq_along(dose_ratio) - 1
booster_df <- squire.page:::run_booster(
country = "United Kingdom",
primary_doses = 100000,
tt_primary_doses = primary_doses,
second_dose_delay = dose_delay,
booster_doses = 0,
tt_booster_doses = 0,
time_period = t,
vaccine_booster_follow_up_coverage = rep(0, 17),
vaccine_efficacy_infection = c(ve_i_f, ve_i_s, ve_i_s, 0, 0, 0, 0),
vaccine_efficacy_disease = c(ve_d_f, ve_d_s, ve_d_s, 0, 0, 0, 0),
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = matrix(
c(0.5, 0.5, 0.5, 1, 1, 1, 1), ncol = 17, nrow = 7),
dur_V = rep(50, 4),
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
nimue_df <- nimue::run(
country = "United Kingdom",
max_vaccine = 100000,
tt_vaccine = 0,
time_period = t,
tt_vaccine_efficacy_infection = tt_vaccine,
vaccine_efficacy_infection = as.list(ve_i_nimue),
tt_vaccine_efficacy_disease = tt_vaccine,
vaccine_efficacy_disease = as.list(ve_d_nimue),
dur_V = 100 + 14 + 60,
dur_vaccine_delay = 14,
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = 0.5,
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
rbind(
booster_df %>%
mutate(
Model = "Booster"
), nimue_df %>%
mutate(Model = "Nimue")
) %>%
mutate(compartment = stringr::str_to_title(compartment)) %>%
ggplot() +
geom_line(aes(x = t, y = y, colour = Model), size = 1, alpha = 0.5) +
facet_wrap(vars(compartment), scales = "free", strip.position = "left") +
labs(y = "", title = "Two dose with waning")
Lastly including boosters in the booster model, we would expect a delay in deaths until waning overwhelms.
booster_doses <- 10000
ve_i_b <- 0.9
ve_i_b_2 <- 0.45
ve_d_b <- 0.9
ve_d_b_2 <- 0.45
booster_df <- squire.page:::run_booster(
country = "United Kingdom",
primary_doses = 100000,
tt_primary_doses = primary_doses,
second_dose_delay = dose_delay,
booster_doses = booster_doses,
tt_booster_doses = 0,
time_period = t,
vaccine_booster_follow_up_coverage = rep(0, 17),
vaccine_efficacy_infection = c(ve_i_f, ve_i_s, ve_i_s, 0, ve_i_b, ve_i_b_2, 0),
vaccine_efficacy_disease = c(ve_d_f, ve_d_s, ve_d_s, 0, ve_d_b, ve_d_b_2, 0),
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = matrix(
c(0.5, 0.5, 0.5, 1, 0.5, 0.5, 1), ncol = 17, nrow = 7),
dur_V = c(rep(50, 2), rep(100, 2)),
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
nimue_df <- nimue::run(
country = "United Kingdom",
max_vaccine = 100000,
tt_vaccine = 0,
time_period = t,
tt_vaccine_efficacy_infection = tt_vaccine,
vaccine_efficacy_infection = as.list(ve_i_nimue),
tt_vaccine_efficacy_disease = tt_vaccine,
vaccine_efficacy_disease = as.list(ve_d_nimue),
dur_V = 100,
dur_vaccine_delay = 14,
vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1),
rel_infectiousness_vaccinated = 0.5,
dur_R = dur_R
) %>%
squire.page::nimue_format(var_select = c("infections", "deaths"))
rbind(
booster_df %>%
mutate(
Model = "Booster"
), nimue_df %>%
mutate(Model = "Nimue")
) %>%
mutate(compartment = stringr::str_to_title(compartment)) %>%
ggplot() +
geom_line(aes(x = t, y = y, colour = Model), size = 1, alpha = 0.5) +
facet_wrap(vars(compartment), scales = "free", strip.position = "left") +
labs(y = "", title = "Booster dose")
mrc-ide/squire.page documentation built on May 27, 2023, 11:20 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.
knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) library(tidyr) library(dplyr) library(ggplot2) library(squire.page)
This vignette describes the rewritten nimue booster pathway. This update allows the inclusion of booster doses to vaccination campaigns in the nimue model and allows explicit inclusion of first and second dose efficacies. No changes are made to the infection and hospitalisation pathway.
Model Structure
knitr::include_graphics("./Nimue_Booster_Diagram.png")
Compartment definitions are as follows:
- $uV$ Un-vaccinated population,
- $pV_i$ Partially vaccinated/protected population (i.e. first dose of a two dose regimen),
- $fV_i$ Fully vaccinated/protected population (i.e. both doses of a two dose regimen).
- $bV_i$ Boosted population (at least one booster dose).
Full dose and boosted compartments both feed into waned compartments that represent reduced vaccine efficacy over time. Transition rates are defined as:
- $fD_t$ Daily time-series of first doses,
- $sD_t$ An inferred delay between doses (~60 days),
- $bD_{1,t}$ Daily time-series of initial booster doses,
- $bD_{2,t}$ Daily time-series of follow-up booster doses, can be limited to certain age groups,
- $w_p$ Rate of waning of initial dose protection,
- $w_i$ Rate of waning of boosted dose protection.
Eligibility for follow-up boosters can be restricted to certain age groups with
the parameter vaccine_booster_follow_up_coverage.
Usage
The user is expected to provide a time-series of primary doses, and booster doses. This model is primarily for usage in the global_lmic_reports, and so it not intended for normal usage. The objects necessary for MCMC fitting can be access as so:
#model object squire.page::nimue_booster_model() #likelihood function squire.page::calc_loglikelihood_booster() #pmcmc object squire.page::pmcmc_drjacoby(log_likelihood = squire.page::calc_loglikelihood_booster, nimue_booster_model = squire.page::nimue_booster_model, ... #specific arguments here ) #alternatively rt_optimise(squire_model = squire.page::nimue_booster_model(), ... #Parameter arguments here )
The model can be run as in squire or nimue with the non-exported function
squire.page:::run_booster.
squire.page:::run_booster( country = "United Kingdom", primary_doses = c(100, 1000, 500, 0), tt_primary_doses = c(0, 10, 50, 150), second_dose_delay = 60, booster_doses = c(0, 500, 750), tt_booster_doses = c(0, 200, 400), time_period = 365*2, vaccine_booster_follow_up_coverage = c(rep(0, 17 - 5), rep(1, 5)) ) %>% squire.page::nimue_format(var_select = c("vaccinated_first_dose", "vaccinated_second_dose", "vaccinated_second_waned", "vaccinated_booster_dose", "vaccinated_booster_waned")) %>% tibble() %>% pivot_wider(names_from = compartment, values_from = y) %>% transmute( t = t, `Partial` = vaccinated_first_dose - vaccinated_second_dose, `Primary` = vaccinated_second_dose - vaccinated_booster_dose - vaccinated_second_waned, `Waned (Primary)` = vaccinated_second_waned, `Boosted` = vaccinated_booster_dose - vaccinated_booster_waned, `Waned (Boosted)` = vaccinated_booster_waned ) %>% pivot_longer(c(`Partial`, `Primary`, `Waned (Primary)`, `Boosted`, `Waned (Boosted)`), names_to = "Vaccine Protection", values_to = "Population") %>% ggplot(aes(x = t, y = `Population`, colour = `Vaccine Protection`)) + geom_line()
As the delay in development of vaccination protection from nimue is removed, the time-series for first/second doses provided to the model if internally adjusted via an Erlang distribution with shape 2 and rate 1/7 to simulate this effect. These parameters are customizable in the model.
To simulate a primary single dose vaccine (i.e. Janssen) set both first and second dose efficacies to the same desired level and set the second dose delay to 1.
Parameterisation
Default parameter values are chosen to be representative for the vaccination programmes of LMIC and LIC countries and against the wild-type variant and as such represent no single vaccine but are chosen from a range of values to represent roughly the Adenovirus, Whole Virus, and Subunit vaccines. Note that for work involving these efficacies against Delta and Omicron are calculated elsewhere.
Vaccine Efficacies:
tribble( ~`Compartment`, ~`Protection Against Hospitalisation`, ~`Protection Against Infection`, "~pV~", 0.444, 0.55, "~fV_1~", 0.856, 0.942, "~fV_2~", 0.755, 0.339, "~fV_3~", 0.265, 0.000, "~bV_1~", 0.848, 0.923, "~bV_2~", 0.768, 0.358, "~bV_3~", 0.287, 0.000 ) %>% knitr::kable()
Waning Rates:
- $w_{f,1}$ = 0.014000362 (71.4 days)
- $w_{f,2}$ = 0.001162850 (860.0 days)
- $w_{b,1}$ = 0.009689185 (103.2 days)
- $w_{b,2}$ = 0.000913242 (1094 days)
Delay in second dose protection is assumed to be 60 days. Note that VE against hospitalisation is scaled for break through infections.
See inst/misc/fit_ve_curve.r for the code used to fit these curves.
To calculate these values we utilised an approach taken previously with waning vaccine efficacy via AB titres (Report 48). We took our assumed non-waned efficacies and then created an median waning curve from these values. Then we fit the waning rates and waned compartment values to recreate these curves. The plots of these fits are shown below.
knitr::include_graphics("./fitted_value_plot.png")
Comparison to nimue
Comparing the two models in the absence of vaccinations should give identical results, outside of minor variations due to the random ages of the initial infections.
t <- 700 dur_R <- 365 booster_df <- squire.page:::run_booster( country = "United Kingdom", primary_doses = 0, tt_primary_doses = 0, second_dose_delay = 1, booster_doses = 0, tt_booster_doses = 0, time_period = t, vaccine_booster_follow_up_coverage = rep(0, 17), dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) nimue_df <- nimue::run( country = "United Kingdom", max_vaccine = 0, tt_vaccine = 0, time_period = t, dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) rbind( booster_df %>% mutate( Model = "Booster" ), nimue_df %>% mutate(Model = "Nimue") ) %>% mutate(compartment = stringr::str_to_title(compartment)) %>% ggplot() + geom_line(aes(x = t, y = y, colour = Model), linewidth = 1, alpha = 0.5) + facet_wrap(vars(compartment), scales = "free", strip.position = "left") + labs(y = "", title = "No Vaccinations")
Comparing the two models with only primary doses (with a flat efficacy for first/second) and no waning should also be identical
t_old <- t t <- 200 booster_df <- squire.page:::run_booster( country = "United Kingdom", primary_doses = 100000, tt_primary_doses = 0, second_dose_delay = 1, booster_doses = 0, tt_booster_doses = 0, time_period = t, vaccine_booster_follow_up_coverage = rep(0, 17), vaccine_efficacy_infection = rep(0.5, 7), vaccine_efficacy_disease = rep(0.5, 7), vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = matrix( rep(0.5, 7), ncol = 17, nrow = 7 ), dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) nimue_df <- nimue::run( country = "United Kingdom", max_vaccine = 100000, tt_vaccine = 0, time_period = t, vaccine_efficacy_infection = 0.5, vaccine_efficacy_disease = 0.5, dur_V = Inf, dur_vaccine_delay = 14, vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = 0.5, dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) rbind( booster_df %>% mutate( Model = "Booster" ), nimue_df %>% mutate(Model = "Nimue") ) %>% mutate(compartment = stringr::str_to_title(compartment)) %>% ggplot() + geom_line(aes(x = t, y = y, colour = Model), linewidth = 1, alpha = 0.5) + facet_wrap(vars(compartment), scales = "free", strip.position = "left") + labs(y = "", title = "Single dose no waning") t <- t_old
With waning we would expect to see almost no difference.
booster_df <- squire.page:::run_booster( country = "United Kingdom", primary_doses = 100000, tt_primary_doses = 0, second_dose_delay = 0, booster_doses = 0, tt_booster_doses = 0, time_period = t, vaccine_booster_follow_up_coverage = rep(0, 17), vaccine_efficacy_infection = c(0.5, 0.5, 0.5, 0, 0, 0, 0), vaccine_efficacy_disease = c(0.5, 0.5, 0.5, 0, 0, 0, 0), vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = matrix( c(0.5, 0.5, 0.5, 1, 1, 1, 1), ncol = 17, nrow = 7, ), dur_V = rep(50, 4), dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) nimue_df <- nimue::run( country = "United Kingdom", max_vaccine = 100000, tt_vaccine = 0, time_period = t, vaccine_efficacy_infection = 0.5, vaccine_efficacy_disease = 0.5, dur_V = 100 + 14, dur_vaccine_delay = 14, vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = 0.5, dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) rbind( booster_df %>% mutate( Model = "Booster" ), nimue_df %>% mutate(Model = "Nimue") ) %>% mutate(compartment = stringr::str_to_title(compartment)) %>% ggplot() + geom_line(aes(x = t, y = y, colour = Model), size = 1, alpha = 0.5) + facet_wrap(vars(compartment), scales = "free", strip.position = "left") + labs(y = "", title = "Single dose with waning")
In the plot above we increase the duration of waning in nimue by 14 days to account for the fact that in the booster model the 14 day delay in developing VE is applied for both first and second doses. Otherwise the second peak occurs a couple of days sooner in nimue.
To simulate two doses we first consider the situation with a delay of 60 days between the two, for nimue this is translated into a dose ratio and the VE are scaled. Again for nimue we must increase the duration of protection to account for the delay between doses.
dose_delay <- 60 ve_i_f <- 0.25 ve_i_s <- 0.75 ve_d_f <- 0.25 ve_d_s <- 0.75 primary_doses <- 100000 eligible_pop <- sum(squire::population$n[squire::population$iso3c == "GBR"])*0.8 #will hit saturation curr_first <- cumsum(rep(primary_doses, floor(eligible_pop/primary_doses))) curr_first <- c(curr_first, rep(eligible_pop, t - length(curr_first))) curr_second <- c(rep(0, dose_delay), head(curr_first, length(curr_first) - dose_delay)) dose_ratio <- curr_second/curr_first ve_i_nimue <- ve_i_f * (1 - dose_ratio) + ve_i_s * dose_ratio ve_d_nimue <- ve_d_f * (1 - dose_ratio) + ve_d_s * dose_ratio tt_vaccine <- seq_along(dose_ratio) - 1 booster_df <- squire.page:::run_booster( country = "United Kingdom", primary_doses = 100000, tt_primary_doses = primary_doses, second_dose_delay = dose_delay, booster_doses = 0, tt_booster_doses = 0, time_period = t, vaccine_booster_follow_up_coverage = rep(0, 17), vaccine_efficacy_infection = c(ve_i_f, ve_i_s, ve_i_s, 0, 0, 0, 0), vaccine_efficacy_disease = c(ve_d_f, ve_d_s, ve_d_s, 0, 0, 0, 0), vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = matrix( c(0.5, 0.5, 0.5, 1, 1, 1, 1), ncol = 17, nrow = 7), dur_V = rep(50, 4), dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) nimue_df <- nimue::run( country = "United Kingdom", max_vaccine = 100000, tt_vaccine = 0, time_period = t, tt_vaccine_efficacy_infection = tt_vaccine, vaccine_efficacy_infection = as.list(ve_i_nimue), tt_vaccine_efficacy_disease = tt_vaccine, vaccine_efficacy_disease = as.list(ve_d_nimue), dur_V = 100 + 14 + 60, dur_vaccine_delay = 14, vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = 0.5, dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) rbind( booster_df %>% mutate( Model = "Booster" ), nimue_df %>% mutate(Model = "Nimue") ) %>% mutate(compartment = stringr::str_to_title(compartment)) %>% ggplot() + geom_line(aes(x = t, y = y, colour = Model), size = 1, alpha = 0.5) + facet_wrap(vars(compartment), scales = "free", strip.position = "left") + labs(y = "", title = "Two dose with waning")
Lastly including boosters in the booster model, we would expect a delay in deaths until waning overwhelms.
booster_doses <- 10000 ve_i_b <- 0.9 ve_i_b_2 <- 0.45 ve_d_b <- 0.9 ve_d_b_2 <- 0.45 booster_df <- squire.page:::run_booster( country = "United Kingdom", primary_doses = 100000, tt_primary_doses = primary_doses, second_dose_delay = dose_delay, booster_doses = booster_doses, tt_booster_doses = 0, time_period = t, vaccine_booster_follow_up_coverage = rep(0, 17), vaccine_efficacy_infection = c(ve_i_f, ve_i_s, ve_i_s, 0, ve_i_b, ve_i_b_2, 0), vaccine_efficacy_disease = c(ve_d_f, ve_d_s, ve_d_s, 0, ve_d_b, ve_d_b_2, 0), vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = matrix( c(0.5, 0.5, 0.5, 1, 0.5, 0.5, 1), ncol = 17, nrow = 7), dur_V = c(rep(50, 2), rep(100, 2)), dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) nimue_df <- nimue::run( country = "United Kingdom", max_vaccine = 100000, tt_vaccine = 0, time_period = t, tt_vaccine_efficacy_infection = tt_vaccine, vaccine_efficacy_infection = as.list(ve_i_nimue), tt_vaccine_efficacy_disease = tt_vaccine, vaccine_efficacy_disease = as.list(ve_d_nimue), dur_V = 100, dur_vaccine_delay = 14, vaccine_coverage_mat = matrix(0.8, ncol = 17, nrow = 1), rel_infectiousness_vaccinated = 0.5, dur_R = dur_R ) %>% squire.page::nimue_format(var_select = c("infections", "deaths")) rbind( booster_df %>% mutate( Model = "Booster" ), nimue_df %>% mutate(Model = "Nimue") ) %>% mutate(compartment = stringr::str_to_title(compartment)) %>% ggplot() + geom_line(aes(x = t, y = y, colour = Model), size = 1, alpha = 0.5) + facet_wrap(vars(compartment), scales = "free", strip.position = "left") + labs(y = "", title = "Booster dose")
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.