Skip to content

Commit 6c3c089

Browse files
avallecamavallecam
committed
basal templates
1 parent abd3c67 commit 6c3c089

File tree

2 files changed

+321
-0
lines changed

2 files changed

+321
-0
lines changed

‎instructors/data/04-practical-activity-1-fr.R‎

Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
# nolint start
2+
3+
# Practical 4
4+
# Activity 1
5+
6+
# step: fill in your room number
7+
room_number <- #<COMPLETE> replace with 1/2/3/4
8+
9+
# Load packages ----------------------------------------------------------
10+
library(epidemics)
11+
library(socialmixr)
12+
library(tidyverse)
13+
14+
15+
# (1) Contact matrix ------------------------------------------------------
16+
17+
# note: all input parameters come from
18+
# the table of parameters of the practical document
19+
20+
# step: paste the survey link assigned to your room
21+
# then run the function to download the social contact data
22+
socialsurvey <- socialmixr::get_survey(
23+
#<COMPLETE>
24+
)
25+
26+
socialsurvey
27+
28+
# step: generate the contact matrix by defining
29+
# - the survey class object just downloaded,
30+
# - the country name,
31+
# - the age limits, as in the table of parameters, and
32+
# - TRUE or FALSE to create a symmetric matrix.
33+
contact_data <- socialmixr::contact_matrix(
34+
#<COMPLETE>
35+
)
36+
37+
contact_data
38+
39+
# run: confirm the symmetry of the matrix
40+
# Matrix are symmetric for the total number of contacts.
41+
# The total number of contacts from one group to another is the same in both directions.
42+
# Check this by multiplying the mean contacts by the population size for each group.
43+
contact_data$matrix * contact_data$demography$proportion
44+
45+
# run: Prepare contact matrix
46+
#
47+
# - {socialmixr} provides a matrix from-to: from-participants -> to-contacts
48+
# In surveys, participants report their contacts.
49+
#
50+
# - {epidemics} expects a matrix to-from: to-contacts <- from-participants
51+
# Models assume that each susceptible (contact) is exposed to infection based on
52+
# how often they are contacted (by participants) and how infectious (participatns) are.
53+
#
54+
socialcontact_matrix <- t(contact_data$matrix)
55+
56+
socialcontact_matrix
57+
58+
# (2) Initial conditions --------------------------------------------------
59+
60+
## Infectious population ---------
61+
62+
# step: add the proportion of infectious
63+
# as given in table of parameter
64+
initial_i <- #<COMPLETE>
65+
66+
# run: create an infectious vector
67+
initial_conditions_inf <- c(
68+
S = 1 - initial_i,
69+
E = 0,
70+
I = initial_i,
71+
R = 0,
72+
V = 0
73+
)
74+
75+
initial_conditions_inf
76+
77+
## Free of infection population ---------
78+
79+
# run: create an infection-free vector
80+
initial_conditions_free <- c(
81+
S = 1,
82+
E = 0,
83+
I = 0,
84+
R = 0,
85+
V = 0
86+
)
87+
88+
initial_conditions_free
89+
90+
## Combine initial conditions ------------
91+
92+
# note: not all the population needs to be infectious.
93+
# The epidemic can start with infecitous in a specific age range.
94+
95+
# step: Combine the initial conditions
96+
# Add initial_conditions_inf or initial_conditions_free
97+
# to the each age group as detailed in table of parameter
98+
initial_conditions <- base::rbind(
99+
#<COMPLETE>, # age group 1
100+
#<COMPLETE>, # age group 2
101+
#<COMPLETE> # age group 3
102+
)
103+
104+
# run: Use contact matrix to assign age group names
105+
rownames(initial_conditions) <- rownames(socialcontact_matrix)
106+
107+
initial_conditions
108+
109+
# (3) Population structure ------------------------------------------------
110+
111+
# run: Prepare the demography vector
112+
demography_vector <- contact_data$demography$population
113+
names(demography_vector) <- rownames(socialcontact_matrix)
114+
115+
# step: Prepare the population to model as affected by the epidemic adding
116+
# - the name of the country,
117+
# - the symmetric and transposed contact matrix,
118+
# - the vector with the population size of each age group
119+
# - the binded matrix with initial conditions for each age group
120+
population_object <- epidemics::population(
121+
#<COMPLETE>
122+
)
123+
124+
population_object
125+
126+
# (4) Model parameters ----------------------------------------------------
127+
128+
# step: define the disease-specific parameters: the rates
129+
# add the values as given in table of parameter
130+
infectiousness_rate <- 1 / #<COMPLETE> # 1/pre-infectious period
131+
recovery_rate <- 1 / #<COMPLETE> # 1/infectious period
132+
transmission_rate <- recovery_rate * #<COMPLETE> # recovery rate * R0
133+
134+
135+
# (5) Run the model --------------------------------------------------------
136+
137+
# step: in each function argument add
138+
# - the population object
139+
# - each of the previously defined disease-specific rates
140+
# - the total simulation time as given in table of parameter
141+
simulate_baseline <- epidemics::model_default(
142+
#<COMPLETE>
143+
)
144+
145+
simulate_baseline
146+
147+
148+
# (6) Plot all compartments ------------------------------------------------
149+
150+
# run: paste plot in report
151+
152+
# plot with total number of individual per compartment
153+
# at different points in time
154+
simulate_baseline %>%
155+
ggplot(aes(
156+
x = time,
157+
y = value,
158+
color = compartment,
159+
linetype = demography_group
160+
)) +
161+
geom_line() +
162+
scale_y_continuous(
163+
breaks = scales::breaks_pretty(n = 10),
164+
labels = scales::comma
165+
)
166+
167+
# (7) Peak of infectious -------------------------------------------------
168+
169+
# run: paste table output in report
170+
171+
# table of epidemic peak size and time
172+
# per demographic group
173+
epidemics::epidemic_peak(data = simulate_baseline)
174+
175+
176+
# (8) Plot new infections -------------------------------------------------
177+
178+
# run: paste plot output in report
179+
180+
# New infections per demographic group in time
181+
newinfections_bygroup <- epidemics::new_infections(data = simulate_baseline)
182+
183+
# Visualize the spread of the epidemic in terms of new infections
184+
newinfections_bygroup %>%
185+
ggplot(aes(time, new_infections, colour = demography_group)) +
186+
geom_line() +
187+
scale_y_continuous(
188+
breaks = scales::breaks_pretty(n = 10),
189+
labels = scales::comma
190+
)
191+
192+
# nolint end

‎instructors/data/04-practical-activity-2-fr.R‎

Lines changed: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
1+
# nolint start
2+
3+
# Practical 4
4+
# Activity 2
5+
6+
# step: fill in your room number
7+
room_number <- #<COMPLETE> replace with 1/2/3/4
8+
9+
# Intervention ---------------------------------------------------------
10+
11+
# note: all input parameters come from
12+
# the table of parameters of the practical document
13+
14+
rownames(socialcontact_matrix)
15+
16+
# step: create the intervention object:
17+
#
18+
# identify if you need to keep:
19+
# epidemics::intervention() or epidemics::vaccination()
20+
#
21+
# then add:
22+
# - name of the intervention
23+
# - type of intervention ("rate" or "contacts"), if needed
24+
# - time when the intervention begins and ends (as values or matrix*)
25+
# - reduction or vaccination rate (as values or matrix*)
26+
#
27+
# *if matrix, values follow same order as in the social contact matrix
28+
#
29+
test_intervention <- epidemics::intervention(#<COMPLETE>
30+
)
31+
# or
32+
test_intervention <- epidemics::vaccination(#<COMPLETE>
33+
)
34+
35+
test_intervention
36+
37+
# Run {epidemics} ---------------------------------------------------------
38+
39+
# step: add the intervention argument
40+
#
41+
# as a list (for interventions against contacts or transmission rate)
42+
# or as an object (for vaccination)
43+
#
44+
simulate_intervention <- epidemics::model_default(
45+
population = population_object,
46+
transmission_rate = transmission_rate,
47+
infectiousness_rate = infectiousness_rate,
48+
recovery_rate = recovery_rate,
49+
# Intervention
50+
#<COMPLETE>,
51+
time_end = 1000,
52+
increment = 1.0
53+
)
54+
55+
simulate_intervention
56+
57+
# Plot all compartments --------------------------------------------------
58+
59+
# run: paste plot in report
60+
61+
simulate_intervention %>%
62+
ggplot(aes(
63+
x = time,
64+
y = value,
65+
color = compartment,
66+
linetype = demography_group
67+
)) +
68+
geom_line() +
69+
geom_vline(
70+
xintercept = c(test_intervention$time_begin, test_intervention$time_end),
71+
linetype = "dashed",
72+
linewidth = 0.2
73+
) +
74+
scale_y_continuous(
75+
breaks = scales::breaks_pretty(n = 10),
76+
labels = scales::comma
77+
)
78+
79+
80+
# Peak of infectious -----------------------------------------------------
81+
82+
# run: paste table output in report
83+
84+
epidemics::epidemic_peak(data = simulate_intervention)
85+
86+
# Visualize effect --------------------------------------------------------
87+
# Plot new infections
88+
89+
# step:
90+
# - add intervention name
91+
# - if your intervention is vaccination, then
92+
# - activate the argument "exclude_compartments"
93+
# - run and paste plot output in report
94+
95+
infections_baseline <- epidemics::new_infections(
96+
data = simulate_baseline,
97+
# exclude_compartments = "vaccinated", # if vaccination
98+
by_group = FALSE # if TRUE, then age-stratified output
99+
)
100+
101+
infections_intervention <- epidemics::new_infections(
102+
data = simulate_intervention,
103+
# exclude_compartments = "vaccinated", # if vaccination
104+
by_group = FALSE # if TRUE, then age-stratified output
105+
)
106+
107+
# Assign scenario names
108+
infections_baseline$scenario <- "Baseline"
109+
infections_intervention$scenario <- "ADD Intervention Name" #<COMPLETE>
110+
111+
# Combine the data from both scenarios
112+
infections_baseline_intervention <- bind_rows(infections_baseline, infections_intervention)
113+
114+
infections_baseline_intervention %>%
115+
ggplot(aes(
116+
x = time,
117+
y = new_infections,
118+
colour = scenario,
119+
# linetype = demography_group # if by_group = TRUE
120+
)) +
121+
geom_line() +
122+
geom_vline(
123+
xintercept = c(test_intervention$time_begin, test_intervention$time_end),
124+
linetype = "dashed",
125+
linewidth = 0.2
126+
) +
127+
scale_y_continuous(labels = scales::comma)
128+
129+
# nolint end

0 commit comments

Comments
 (0)