rough first pass at age-structured SIR

inst/starter_models/sir_age/README.Rmd

@@ -0,0 +1,168 @@
+---
+title: "Age-stratified SIR"
+index_entry: "An age-stratified SIR model"
+bibliography: ../../references.bib
+link-citations: TRUE
+author: Irena Papst, Steve Walker
+output: 
+  github_document:
+    toc: true
+editor_options: 
+  chunk_output_type: console
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  warning = FALSE,
+  message = FALSE,
+  comment = "#>",
+  fig.path = "./figures/"
+)
+```
+
+This is an expansion of the [sir](https://github.com/canmod/macpan2/tree/main/inst/starter_models/sir) model to include age-stratification; each state variable is subdivided by age, and transmission is governed by a age-based contact matrix, as described in [@Mistry2021].
+
+# Packages Used and Settings
+
+The code in this article uses the following packages.
+
+```{r packages, message=FALSE, warning=FALSE}
+library(ggplot2)
+library(dplyr)
+library(forcats)
+library(scales)
+library(macpan2)
+```
+
+# Model Specification
+
+This model has been specified in the `sir_age` directory [here](https://github.com/canmod/macpan2/blob/main/inst/starter_models/sir_age/tmb.R) and is accessible from the `macpan2` model library (see [Example Models](https://canmod.github.io/macpan2/articles/example_models.html) for details). We can read in the model specification using the `mp_tmb_library` command.
+```{r model_spec}
+spec = mp_tmb_library(
+    "starter_models"
+  , "sir_age"
+  , package = "macpan2"
+)
+```
+
+This specification can be used to draw the following flow diagram using code found in the [source for this article](https://github.com/canmod/macpan2/blob/main/inst/starter_models/sir_age/README.Rmd).
+
+```{r diagram, echo = FALSE, eval = FALSE, fig.height = 2, fig.width = 8}
+system.file("utilss", "box-drawing.R", package = "macpan2") |> source()
+layout = mp_layout_paths(spec)
+(layout
+  |> plot_flow_diagram(show_flow_names = TRUE)
+  |> draw_inflows(layout, show_labels = TRUE)
+  |> draw_outflows(layout, show_labels = TRUE, pattern_mutate = "^([a-z]*)(_.*)", pattern_replace = "\\1")
+)
+```
+
+
+# States
+
+| variable | description                       |
+| -------- | --------------------------------- |
+| S        | Number of susceptible individuals |
+| I        | Number of infectious individuals  |
+| R        | Number of recovered individuals   |
+
+Each state variable is a vector with one entry per age group. 
+
+The size of the population in each age groups is given by the components of $N = S + I + R$.
+
+# Parameters
+
+| variable | description                  |
+| -------- | ---------------------------- |
+| $\tau$  | transmissibility, _i.e._, the proportion of contacts with infecteds that yield infection |
+| $\gamma$ | per capita recovery rate     |
+| $M$    | matrix of contact rates between age groups, _e.g._ $M_{ij}$ is the rate of contact between susceptibles of age $i$ and infecteds of age $j$        |
+
+$\tau$ and $\gamma$ can be specified by age (as vectors), though in the example below we use a scalar value that applies to all age groups.
+
+# Dynamics 
+
+$$
+\begin{align*}
+\frac{dS}{dt} &= - \lambda S \\
+\frac{dI}{dt} &= \lambda S - \gamma I \\
+\frac{dR}{dt} &= \gamma I
+\end{align*}
+$$
+
+Here $\lambda = \tau M \frac{I}{N}$.
+
+# Simulation Example
+
+```{r plot_sim}
+# set numerical values
+N <- rep(1e5, 3) # total population by age
+I0 <- 100 # initial infecteds
+
+M <- matrix(c(
+  10, 1, 1, 
+  1, 5, 1, 
+  1, 1, 2
+  ), nrow = 3) # contact matrix in units of avg number of contacts/person/day (symmetric contact rates because we will pick two age groups of the same size)
+gamma <- 1/5 # 5 days avg infectious period; same gamma across age groups
+
+R0 <- 2
+# spectral radius of contact matrix for transmissibility calculation
+rho <- max(abs(eigen(M)$values))
+# calculate transmissibility given R0, gamma, M
+tau <- R0*gamma/rho # transmissibility (proportion of contacts with infectious individuals that yield infection)
+
+# variable labellers
+matrix_labeller <-  c(
+  "S" = "Susceptible",
+  "I" = "Infectious",
+  "R" = "Recovered"
+)
+row_labeller <- c(
+  "0" = "Children (ages 0-17)",
+  "1" = "Adults (ages 18-64)",
+  "2" = "Seniors (ages 65+)"
+)
+
+# simulate & visualize
+(spec
+  # simulate
+  |> mp_simulator(
+    time_steps = 150
+  , outputs = mp_state_vars(spec)
+  )
+  |> mp_trajectory()
+  # enforce natural order of variables for plotting
+  |> dplyr::mutate(
+    matrix = factor(matrix, levels = mp_state_vars(spec))
+   , row = forcats::as_factor(row)
+   )
+  # visualize trajectory
+  |> ggplot2::ggplot(
+    mapping = ggplot2::aes(x = time, y = value, colour = row)
+  ) 
+  + ggplot2::geom_line() +
+  + ggplot2::facet_wrap(
+      ~ matrix, 
+      labeller = ggplot2::labeller(
+        matrix = matrix_labeller
+      ),
+      scales = "free_y")
+  + ggplot2::scale_colour_discrete(
+      labels = row_labeller
+    )
+  + ggplot2::labs(
+      title = "Simulation of the age-structured SIR model with two age groups",
+      subtitle = paste("Infection is seeded with", I0, "infectious children in a total population of", scales::label_number(scale_cut = scales::cut_short_scale())(sum(N))),
+      x = "Days from beginning of outbreak",
+      y = "Number of individuals"
+    )
+  + ggplot2::theme(
+      legend.position = "bottom"
+    , legend.title = ggplot2::element_blank()
+    )
+)
+```
+
+# References

inst/starter_models/sir_age/references.bib

@@ -0,0 +1,13 @@
+@article{Mistry2021,
+  title = {Inferring high-resolution human mixing patterns for disease modeling},
+  volume = {12},
+  ISSN = {2041-1723},
+  url = {http://dx.doi.org/10.1038/s41467-020-20544-y},
+  DOI = {10.1038/s41467-020-20544-y},
+  number = {1},
+  journal = {Nature Communications},
+  publisher = {Springer Science and Business Media LLC},
+  author = {Mistry,  Dina and Litvinova,  Maria and Pastore y Piontti,  Ana and Chinazzi,  Matteo and Fumanelli,  Laura and Gomes,  Marcelo F. C. and Haque,  Syed A. and Liu,  Quan-Hui and Mu,  Kunpeng and Xiong,  Xinyue and Halloran,  M. Elizabeth and Longini,  Ira M. and Merler,  Stefano and Ajelli,  Marco and Vespignani,  Alessandro},
+  year = {2021},
+  month = jan 
+}

inst/starter_models/sir_age/tmb.R

@@ -0,0 +1,35 @@
+library(macpan2)
+
+# SIR with age, where age structure only affects transmission, as 
+# defined here: https://www.nature.com/articles/s41467-020-20544-y#Sec7
+
+# define the model
+spec = mp_tmb_model_spec(
+  before = list(
+    S ~ N - I - R # calculate population size before the simulation loop begins to avoid having to specify a value for it by hand in the defaults list
+  ),
+  during = list(
+    # force of infection
+    lambda ~ tau * M %*% (I / N),
+    # infection
+    mp_per_capita_flow(
+      from = "S", to = "I",
+      rate = "lambda",
+      abs_rate = "infection"
+    ),
+    # recovery
+    mp_per_capita_flow(
+      from = "I", to = "R",
+      rate = "gamma",
+      abs_rate = "recovery"
+    )
+  ),
+  default = list(
+    tau = tau,
+    M = M,
+    gamma = gamma, # 5 days avg infectious period; same gamma across age groups 
+    N = N,
+    I = c(I0, 0, 0), # seed infection in age group 1
+    R = rep(0, 3)
+  )
+)