apply contactsurveys/socialmixr pattern to all downstream episodes

Replace socialmixr::polymod and socialmixr::get_survey() with
contactsurveys::download_survey() + socialmixr::load_survey() using
the Zenodo DOI. Add return_demography = TRUE and standardize object
names (contacts_byage, contacts_byage_matrix) across:
- simulating-transmission.Rmd
- modelling-interventions.Rmd
- compare-interventions.Rmd
- disease-burden.Rmd
- vaccine-comparisons.Rmd
- template.Rmd

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

Author: avallecam

episodes/compare-interventions.Rmd

@@ -12,20 +12,26 @@ library(epidemics)
 # hidden seed for stable stochastic output in lesson
 set.seed(33)
 
-polymod <- socialmixr::polymod
-contact_data <- socialmixr::contact_matrix(
-  polymod,
+survey_files <- contactsurveys::download_survey(
+  survey = "https://doi.org/10.5281/zenodo.3874557",
+  verbose = FALSE
+)
+survey_load <- socialmixr::load_survey(files = survey_files)
+
+contacts_byage <- socialmixr::contact_matrix(
+  survey = survey_load,
   countries = "United Kingdom",
   age_limits = c(0, 15, 65),
-  symmetric = TRUE
+  symmetric = TRUE,
+  return_demography = TRUE
 )
 
 # prepare contact matrix
-contact_matrix <- t(contact_data$matrix)
+contacts_byage_matrix <- t(contacts_byage$matrix)
 
 # prepare the demography vector
-demography_vector <- contact_data$demography$population
-names(demography_vector) <- rownames(contact_matrix)
+demography_vector <- contacts_byage$demography$population
+names(demography_vector) <- rownames(contacts_byage_matrix)
 
 # initial conditions: one in every 1 million is infected
 initial_i <- 1e-6
@@ -35,15 +41,15 @@ initial_conditions <- c(
 
 # build for all age groups
 initial_conditions <- matrix(
-  rep(initial_conditions, dim(contact_matrix)[1]),
+  rep(initial_conditions, dim(contacts_byage_matrix)[1]),
   ncol = 5, byrow = TRUE
 )
-rownames(initial_conditions) <- rownames(contact_matrix)
+rownames(initial_conditions) <- rownames(contacts_byage_matrix)
 
 # prepare the population to model as affected by the epidemic
 uk_population <- epidemics::population(
   name = "UK",
-  contact_matrix = contact_matrix,
+  contact_matrix = contacts_byage_matrix,
   demography_vector = demography_vector,
   initial_conditions = initial_conditions
 )
@@ -355,19 +361,25 @@ output <- epidemics::model_vacamole(
 1.  Run the model
 
 ```{r}
-polymod <- socialmixr::polymod
-contact_data <- socialmixr::contact_matrix(
-  survey = polymod,
+survey_files_2 <- contactsurveys::download_survey(
+  survey = "https://doi.org/10.5281/zenodo.3874557",
+  verbose = FALSE
+)
+survey_load_2 <- socialmixr::load_survey(files = survey_files_2)
+
+contacts_byage_2 <- socialmixr::contact_matrix(
+  survey = survey_load_2,
   countries = "United Kingdom",
   age_limits = c(0, 20, 40),
-  symmetric = TRUE
+  symmetric = TRUE,
+  return_demography = TRUE
 )
 # prepare contact matrix
-contact_matrix <- t(contact_data$matrix)
+contacts_byage_matrix_2 <- t(contacts_byage_2$matrix)
 
 # extract demography vector
-demography_vector <- contact_data$demography$population
-names(demography_vector) <- rownames(contact_matrix)
+demography_vector <- contacts_byage_2$demography$population
+names(demography_vector) <- rownames(contacts_byage_matrix_2)
 
 # prepare initial conditions
 initial_i <- 1e-6
@@ -385,12 +397,12 @@ initial_conditions_vacamole <- rbind(
   initial_conditions_vacamole,
   initial_conditions_vacamole
 )
-rownames(initial_conditions_vacamole) <- rownames(contact_matrix)
+rownames(initial_conditions_vacamole) <- rownames(contacts_byage_matrix_2)
 
 # prepare population object
 uk_population_vacamole <- epidemics::population(
   name = "UK",
-  contact_matrix = contact_matrix,
+  contact_matrix = contacts_byage_matrix_2,
   demography_vector = demography_vector,
   initial_conditions = initial_conditions_vacamole
 )

episodes/disease-burden.Rmd

@@ -47,6 +47,7 @@ In this tutorial, we'll focus on the separated approach, where we first run an e
 ```{r, warning = FALSE, message = FALSE}
 library(epiparameter)
 library(epidemics)
+library(contactsurveys)
 library(socialmixr)
 library(tidyverse)
 ```
@@ -83,21 +84,27 @@ We'll use `{epiparameter}` to define these delay distributions. The Gamma distri
 :::::::::::::::: instructor
 
 ```{r, echo = TRUE, message = FALSE}
-# load contact and population data from socialmixr::polymod
-polymod <- socialmixr::polymod
-contact_data <- socialmixr::contact_matrix(
-  polymod,
+# download and load contact and population data from Zenodo
+survey_files <- contactsurveys::download_survey(
+  survey = "https://doi.org/10.5281/zenodo.3874557",
+  verbose = FALSE
+)
+survey_load <- socialmixr::load_survey(files = survey_files)
+
+contacts_byage <- socialmixr::contact_matrix(
+  survey = survey_load,
   countries = "United Kingdom",
   age_limits = c(0, 20, 40),
-  symmetric = TRUE
+  symmetric = TRUE,
+  return_demography = TRUE
 )
 
 # prepare contact matrix
-contact_matrix <- t(contact_data$matrix)
+contacts_byage_matrix <- t(contacts_byage$matrix)
 
 # prepare the demography vector
-demography_vector <- contact_data$demography$population
-names(demography_vector) <- rownames(contact_matrix)
+demography_vector <- contacts_byage$demography$population
+names(demography_vector) <- rownames(contacts_byage_matrix)
 
 # initial conditions: one in every 1 million is infected
 initial_i <- 1e-6
@@ -115,12 +122,12 @@ initial_conditions <- rbind(
   initial_conditions_free,
   initial_conditions_free
 )
-rownames(initial_conditions) <- rownames(contact_matrix)
+rownames(initial_conditions) <- rownames(contacts_byage_matrix)
 
 # prepare the population to model as affected by the epidemic
 uk_population <- epidemics::population(
   name = "UK",
-  contact_matrix = contact_matrix,
+  contact_matrix = contacts_byage_matrix,
   demography_vector = demography_vector,
   initial_conditions = initial_conditions
 )

episodes/modelling-interventions.Rmd

@@ -57,6 +57,7 @@ In this tutorial, we will learn how to use `{epidemics}` to model interventions
 
 ```{r,message=FALSE,warning=FALSE}
 library(epidemics)
+library(contactsurveys)
 library(socialmixr)
 library(tidyverse)
 ```
@@ -85,23 +86,28 @@ We will investigate the effect of interventions on a COVID-19 outbreak using an
 The SEIR model divides the population into four compartments: Susceptible (S), Exposed (E), Infectious (I), and Recovered (R). We will set the following parameters for our model: $R_0 = 2.7$ (basic reproduction number), latent period or pre-infectious period $= 4$ days, and the infectious period $= 5.5$ days (parameters adapted from [Davies et al. (2020)](https://doi.org/10.1016/S2468-2667(20)30133-X)). We adopt a contact matrix with age bins 0-18, 18-65, 65 years and older using `{socialmixr}`, and assume that one in every 1 million individuals in each age group is infectious at the start of the epidemic.
 
 ```{r model_setup, echo = TRUE, message = FALSE}
-# load survey data
-survey_data <- socialmixr::polymod
+# download and load survey data
+survey_files <- contactsurveys::download_survey(
+  survey = "https://doi.org/10.5281/zenodo.3874557",
+  verbose = FALSE
+)
+survey_load <- socialmixr::load_survey(files = survey_files)
 
 # generate contact matrix
-cm_results <- socialmixr::contact_matrix(
-  survey = survey_data,
+contacts_byage <- socialmixr::contact_matrix(
+  survey = survey_load,
   countries = "United Kingdom",
   age_limits = c(0, 15, 65),
-  symmetric = TRUE
+  symmetric = TRUE,
+  return_demography = TRUE
 )
 
 # transpose contact matrix
-cm_matrix <- t(cm_results$matrix)
+contacts_byage_matrix <- t(contacts_byage$matrix)
 
 # prepare the demography vector
-demography_vector <- cm_results$demography$population
-names(demography_vector) <- rownames(cm_matrix)
+demography_vector <- contacts_byage$demography$population
+names(demography_vector) <- rownames(contacts_byage_matrix)
 
 # initial conditions: one in every 1 million is infected
 initial_i <- 1e-6
@@ -119,12 +125,12 @@ initial_conditions <- base::rbind(
   initial_conditions,
   initial_conditions
 )
-rownames(initial_conditions) <- rownames(cm_matrix)
+rownames(initial_conditions) <- rownames(contacts_byage_matrix)
 
 # prepare the population to model as affected by the epidemic
 uk_population <- epidemics::population(
   name = "UK",
-  contact_matrix = cm_matrix,
+  contact_matrix = contacts_byage_matrix,
   demography_vector = demography_vector,
   initial_conditions = initial_conditions
 )
@@ -176,7 +182,7 @@ The first NPI we will consider is the effect of school closures on reducing the
 To include an intervention in our model we must create an `intervention` object. The inputs are the name of the intervention (`name`), the type of intervention (`contacts` or `rate`), the start time (`time_begin`), the end time (`time_end`) and the reduction (`reduction`). The values of the reduction matrix are specified in the same order as the age groups in the contact matrix. 
 
 ```{r}
-rownames(cm_matrix)
+rownames(contacts_byage_matrix)
 ```
 
 Therefore, we specify `reduction = matrix(c(0.5, 0.01, 0.01))`. We assume that the school closures start on day 50 and continue to be in place for a further 100 days. Therefore our intervention object is: 
@@ -433,8 +439,8 @@ Here we will assume all age groups are vaccinated at the same rate 0.01 and that
 # prepare a vaccination object
 vaccinate <- epidemics::vaccination(
   name = "vaccinate all",
-  time_begin = matrix(40, nrow(cm_matrix)),
-  time_end = matrix(40 + 150, nrow(cm_matrix)),
+  time_begin = matrix(40, nrow(contacts_byage_matrix)),
+  time_end = matrix(40 + 150, nrow(contacts_byage_matrix)),
   nu = matrix(c(0.01, 0.01, 0.01))
 )
 ```

episodes/simulating-transmission.Rmd

@@ -63,6 +63,7 @@ In this tutorial we are going to learn how to use the `{epidemics}` package to s
 
 ```{r,message=FALSE,warning=FALSE}
 library(epidemics)
+library(contactsurveys)
 library(socialmixr)
 library(tidyverse)
 ```
@@ -185,7 +186,7 @@ Using the R package `socialmixr`, obtain the contact matrix for the United Kingd
 + age between 20 and 40,
 + 40 years and over.
 
-Use the survey available at `socialmixr::polymod`
+Use the POLYMOD survey available at `https://doi.org/10.5281/zenodo.3874557`
 
 :::::::::::::::: hint
 
@@ -196,30 +197,35 @@ Use the survey available at `socialmixr::polymod`
 :::::::::::::::::::::::: solution 
 
 ```{r polymod_uk, echo = TRUE, message = FALSE}
-# Access the contact survey data
-polymod <- socialmixr::polymod
+# Download and load the contact survey data
+survey_files <- contactsurveys::download_survey(
+  survey = "https://doi.org/10.5281/zenodo.3874557",
+  verbose = FALSE
+)
+survey_load <- socialmixr::load_survey(files = survey_files)
 
 # Generate the contact matrix
-contact_data <- socialmixr::contact_matrix(
-  polymod,
+contacts_byage <- socialmixr::contact_matrix(
+  survey = survey_load,
   countries = "United Kingdom",
   age_limits = c(0, 20, 40),
-  symmetric = TRUE
+  symmetric = TRUE,
+  return_demography = TRUE
 )
 
 # prepare contact matrix
-socialcontact_matrix <- t(contact_data$matrix)
+contacts_byage_matrix <- t(contacts_byage$matrix)
 
 # print
-socialcontact_matrix
+contacts_byage_matrix
 ```
 
 Remember that the matrix satisfies the `symmetric = TRUE` condition at the level of total number of contacts.
 
-The total number of contacts between groups $i$ and $j$ is calculated as the mean number of contacts (`contact_data$matrix`) multiplied by the number of individuals in group $i$ (`contact_data$demography$population`)
+The total number of contacts between groups $i$ and $j$ is calculated as the mean number of contacts (`contacts_byage$matrix`) multiplied by the number of individuals in group $i$ (`contacts_byage$demography$population`)
 
 ```{r}
-contact_data$matrix * contact_data$demography$population
+contacts_byage$matrix * contacts_byage$demography$population
 ```
 
 :::::::::::::::::::::::::::::::::
@@ -284,22 +290,22 @@ initial_conditions <- rbind(
 )
 
 # use contact matrix to assign age group names
-rownames(initial_conditions) <- rownames(socialcontact_matrix)
+rownames(initial_conditions) <- rownames(contacts_byage_matrix)
 initial_conditions
 ```
 
 
 
 
 ### 3. Population structure
-The population object requires a vector containing the demographic structure of the population. The demographic vector must be a named vector containing the number of individuals in each age group of our given population. In this example, we can extract the demographic information from the `contact_data` object that we obtained using the `socialmixr` package.
+The population object requires a vector containing the demographic structure of the population. The demographic vector must be a named vector containing the number of individuals in each age group of our given population. In this example, we can extract the demographic information from the `contacts_byage` object that we obtained using the `socialmixr` package.
 
 ```{r demography}
 # extract the demography vector
-demography_vector <- contact_data$demography$population
+demography_vector <- contacts_byage$demography$population
 
 # use contact matrix to assign age group names
-names(demography_vector) <- rownames(socialcontact_matrix)
+names(demography_vector) <- rownames(contacts_byage_matrix)
 demography_vector
 ```
 
@@ -310,7 +316,7 @@ library(epidemics)
 
 uk_population <- epidemics::population(
   name = "UK",
-  contact_matrix = socialcontact_matrix,
+  contact_matrix = contacts_byage_matrix,
   demography_vector = demography_vector,
   initial_conditions = initial_conditions
 )