diff --git a/vignettes/time_dependence.Rmd b/vignettes/time_dependence.Rmd index 50cb1295..918f076e 100644 --- a/vignettes/time_dependence.Rmd +++ b/vignettes/time_dependence.Rmd @@ -1,6 +1,13 @@ --- title: "Modelling time-dependence in epidemic parameters" -output: rmarkdown::html_vignette +output: + bookdown::html_vignette2: + fig_caption: yes + code_folding: show +pkgdown: + as_is: true +bibliography: references.json +link-citations: true vignette: > %\VignetteIndexEntry{Modelling time-dependence in epidemic parameters} %\VignetteEncoding{UTF-8} @@ -15,8 +22,8 @@ knitr::opts_chunk$set( comment = "#>", message = FALSE, warning = FALSE, - fig.width = 5, - fig.height = 4 + fig.width = 7, + fig.height = 5 ) ``` @@ -68,6 +75,9 @@ pandemic <- infection( Next we prepare a function that affects the transmission rate $\beta$ in such a way that there are two peaks and two troughs in the transmission rate over the course of a year. +Note that this example uses an arbitrary function, and that we might want to choose a more realistic function in a model. +Nonetheless, as the figures later will show, this can still generate realistic looking epidemic curves and is a good starting point for understanding how this feature works. + ```{r} # prepare function mod_beta <- function(time, x, tmax = 365 / 4) { @@ -86,7 +96,9 @@ output <- mod_beta(seq(0, 365), 1.3 / 7.0) ggplot() + geom_line( aes(x = seq(0, 365), y = output) - ) + ) + + labs(x = "Days", y = "Transmission rate (beta)") + + theme_classic() ``` ## Model with time-dependent transmission @@ -102,14 +114,15 @@ data <- epidemic_default_cpp( ), time_end = 365, increment = 1 ) -``` -We plot the number of newly infectious individuals to check the model dynamics. - -```{r} # get data on new infections data_infections <- new_infections(data) +``` + +We plot the number of newly infectious individuals to check the model dynamics. +Note that plotting code is folded and can be expanded. +```{r class.source = 'fold-hide'} # plot data on new infections ggplot(data_infections) + geom_line( @@ -141,11 +154,11 @@ Here, we can see that the epidemic has a large first wave, followed by a smaller ## Non-pharmaceutical interventions and time-dependence -We can also model the effect of imposing non-pharmaceutical interventions that reduce social contacts, on the trajectory of an epidemic with some time-dependence. +We can also model the effect of imposing non-pharmaceutical interventions that reduce social contacts, on the trajectory of an epidemic with time-dependent changes in the transmission rate. In this example, we impose an intervention with three phases: (1) closing schools, which primarily affects the age group 0 -- 19, then (2) closing workplaces, which affects the age groups > 20 years old, and then (3) partially reopening schools so that the intervention has a lower effect on the social contacts of the age group 0 -- 19. -First we construct the intervention, an object of the `` class. +First we construct the intervention, an object of the `` class. ```{r} # school closures affecting younger age groups @@ -173,6 +186,8 @@ npis <- c(close_schools, close_workplaces, partial_schools) npis ``` +Then we run the model while specifying the time-dependence of the transmission rate, as well as the intervention on social contacts. + ```{r} # run the model with interventions and time-dependence data_npi <- epidemic_default_cpp( @@ -213,10 +228,15 @@ ggplot(data_npi_compare) + ) + scale_color_brewer( palette = "Dark2", - name = "Age group" + name = "Age group", + labels = c("Baseline", "Intervention") ) + - scale_linetype( - name = "Scenario" + scale_linetype_manual( + name = "Scenario", + values = c( + baseline = "dashed", + intervention = "solid" + ) ) + theme_classic() + coord_cartesian( @@ -237,21 +257,28 @@ We can observe that implementing interventions on social contacts can substantia ## Timing vaccination to prevent epidemic peaks We can model the effect of timing vaccination doses to begin with the end of the first wave, at about 120 days. +This example does not include non-pharmaceutical interventions. First we define a vaccination regime that targets adults aged over 40 years as a priority group. +All other age groups are not vaccinated in this campaign. +We also assume that a single dose of the vaccine confers immunity (i.e., non-leaky vaccination). ```{r} # define vaccination object vax_regime <- vaccination( - nu = matrix(0.002, nrow = 3, ncol = 1), + nu = matrix(0.001, nrow = 3, ncol = 1), time_begin = matrix(c(0, 0, 120)), time_end = matrix(c(0, 0, 220)) ) + +# view the vaccination object +vax_regime ``` -We model the effect of administering vaccine doses, and plot the outcome. +We model the effect of administering vaccine doses between the expected peaks of the epidemic waves, and plot the outcome. ```{r} +# pass time dependence and vaccination. Note no interventions data_vax <- epidemic_default_cpp( population = uk_population, infection = pandemic, @@ -273,8 +300,28 @@ data_vax_infections$scenario <- "vaccination" data_vax_compare <- rbindlist(list(data_infections, data_vax_infections)) ``` -```{r} +```{r class.source = 'fold-hide'} ggplot(data_vax_compare) + + geom_rect( + aes( + xmin = 120, xmax = 220, + ymin = 0, ymax = 20e3 + ), + fill = "grey", alpha = 0.1 + ) + + geom_line( + data = data_vax[compartment == "vaccinated" & demography_group == "40+", ], + aes(time, value / 1e2), + colour = "darkblue" + ) + + annotate( + geom = "text", + x = 190, + y = 10e3, + label = "Vaccines administered (100 days)", + angle = 90, + colour = "darkblue" + ) + geom_line( aes( x = time, y = new_infections, @@ -283,17 +330,29 @@ ggplot(data_vax_compare) + ) + scale_y_continuous( labels = scales::comma, - name = "New infections" + name = "New infections", + sec.axis = dup_axis( + trans = function(x) x * 1e2, + name = "Individuals vaccinated", + labels = function(x) { + scales::comma(x, scale = 1e-6, suffix = "M") + } + ) ) + scale_color_brewer( palette = "Dark2", name = "Age group" ) + - scale_linetype( - name = "Scenario" + scale_linetype_manual( + name = "Scenario", + values = c( + baseline = "dashed", + vaccination = "solid" + ) ) + theme_classic() + coord_cartesian( + ylim = c(0, 20e3), expand = FALSE ) + labs( @@ -306,3 +365,7 @@ ggplot(data_vax_compare) + ) ``` +Here, we can see that over 2 million individuals are vaccinated (and immunised; blue line, right-hand Y axis) over the 100 days between the end of the first wave of infections, and the start of the second wave of infections. + +Vaccination reduces the number of daily infections among individuals of all age groups in the second wave. +At its peak, the vaccination scenario sees approximately 5,000 fewer daily infections than the baseline scenario, which may represent a substantial benefit for public health.