generated from epiverse-trace/packagetemplate
/
modelling_vaccination.Rmd
118 lines (95 loc) · 3.11 KB
/
modelling_vaccination.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
---
title: "Modelling the effect of a vaccination campaign"
output:
bookdown::html_vignette2:
fig_caption: yes
code_folding: show
pkgdown:
as_is: true
vignette: >
%\VignetteIndexEntry{Modelling the effect of a vaccination campaign}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
dpi = 150
)
```
```{r setup}
library(epidemics)
```
## Prepare population and initial conditions
Prepare population and contact data.
```{r}
# load contact and population data from socialmixr::polymod
polymod <- socialmixr::polymod
contact_data <- socialmixr::contact_matrix(
polymod,
countries = "United Kingdom",
age.limits = c(0, 20, 65),
symmetric = TRUE
)
# prepare contact matrix
contact_matrix <- t(contact_data$matrix)
# prepare the demography vector
demography_vector <- contact_data$demography$population
names(demography_vector) <- rownames(contact_matrix)
```
Prepare initial conditions for each age group.
```{r}
# initial conditions
initial_i <- 1e-6
initial_conditions <- c(
S = 1 - initial_i, E = 0, I = initial_i, R = 0, V = 0
)
# build for all age groups
initial_conditions <- rbind(
initial_conditions,
initial_conditions,
initial_conditions
)
# assign rownames for clarity
rownames(initial_conditions) <- rownames(contact_matrix)
```
Prepare a population as a `population` class object.
```{r}
uk_population <- population(
name = "UK",
contact_matrix = contact_matrix,
demography_vector = demography_vector,
initial_conditions = initial_conditions
)
```
## Prepare a vaccination campaign
Prepare a vaccination campaign targeting individuals aged over 65.
```{r}
# prepare a vaccination object
vaccinate_elders <- vaccination(
name = "vaccinate elders",
time_begin = matrix(100, nrow(contact_matrix)),
time_end = matrix(250, nrow(contact_matrix)),
nu = matrix(c(0.0001, 0, 0))
)
# view vaccination object
vaccinate_elders
```
::: {.alert .alert-warning}
**Note that** when the vaccination rate is high, the number of individuals who could _potentially_ transition from 'susceptible' to 'vaccinated' may be greater than the number of individuals in the 'susceptible' compartment: $dS_{i_{t}} = \nu_{i_t}S_{i_{0}} > S_{i_{t}}$ for each demographic group $i$ at time $t$.
This could realistically occur when there are more doses available than individuals eligible to receive them, for instance towards the end of an epidemic.
_epidemics_ automatically handles such situations by setting $dS_{i_{t}}$ to be the minimum of doses or eligible individuals: : $dS_{i_t} = \text{Min}(\nu_{i_t}S_{i_0}, S_{i_t})$, such that $S_{i_{t+1}}$ does not take a negative value.
:::
The `<vaccination>` object can be passed to the `vaccination` argument of a model function call.
```{r}
# run an epidemic model using `epidemic`
output <- model_default(
population = uk_population,
vaccination = vaccinate_elders,
time_end = 600, increment = 1.0
)
```
::: {.alert .alert-info}
**Note that** vaccination modelling is currently only supported for the 'default' (`model_default()`) and 'Vacamole' (`model_vacamole()`) models.
:::