In phac-nml-phrsd/wem: Wastewater Epidemic Model

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

Motivation

In real-world settings, the parameters defining an epidemic (e.g., contact rate, asymptomatic proportion, vaccination rate) are not necessarily constant throughout the duration of an epidemic because, for example, behaviour and treatment availability may change.

Hence, some model parameters in wem can be specified has time-dependent. For simplicity, a piecewise linear function represents the time dependence for those parameters. Hence, if $v_1$ and $v_2$ are the values for parameter $x$ at times $t_1$ and $t_2$, then for any $t_1 \leq t \leq t_2$, $x(t)$ is the linear interpolation between the points $(t_1, v_1)$ and $(t_2, v_2)$. For times before the first time point, the value is kept constant, that is $x(t) = v_1$ for all $t \leq t_1$. Similarly, for times beyond the last time point defined, $x(t)=v_2$ for $t \geq t_2$.

Examples

For a time-dependent parameter named (for example) param the convention in the R library wem is to label param.t and param.v the "break points" that define the piecewise linear function.

The example set of model parameters defined in the function model_prm_example() provides an example of time-dependent parameters.

First, let's load this eample set of model parameters:

library(dplyr)
library(tidyr)
library(ggplot2)
library(lubridate)
library(wem)

prm = wem::model_prm_example()

Now, let's extract the parameter that represents the time-dependent multiplicative factor for the transmission rate. Because it is time dependent, it is defined by two vectors of the same size, one that defines the break point times and another defines the break point values. The name of those two vectors are transm.t and transm.v, respectively.

print(prm$transm.t)
print(prm$transm.v)

The example above means that until simulation time $t=45$, the contact rate in the population (defined by prm$R0 , the basic reproduction number parameter $R_0$) remains constant. Then, between times $t=45$ and $t=55$ it decreases linearly to 20% of its previous value. For times beyond $t=55$, the contact rate is constant, still at 20% of its initial value.

Here's a graphical representation of the time-dependent multiplicative factor for transmission:

x = c(0,prm$transm.t, 100)
y = c(prm$transm.v[1], prm$transm.v, prm$transm.v[length(prm$transm.v)])
plot(approx(x,y), typ='l', lwd=3, xlab = 'time', ylab='value', las=1)

We can compare the incidence curve generated by this time-dependent transmission rate with an incidence curve where the transmission rate would have remained constant throughoutthe epidemic

# Simulate epidemic with the time-dependent transmission rate:
sim = simul(prm)
inc = sim$ts$inc
t   = sim$ts$time

# Change the transmission rate to a constant one:
prm$transm.v <- c(1,1)   # instead of "c(1, 0.2)"

# Simulate once more, but now with a constant transmission rate:
sim2 = simul(prm)
inc2 = sim2$ts$inc

df1 = data.frame(t = t, inc = inc, type = 'time-dependent')
df2 = data.frame(t = t, inc = inc2, type = 'constant')

g = rbind(df1, df2) %>%
    filter(t < 100) %>%
    ggplot(aes(x=t, y=inc, color=type)) +
    geom_line(size=1)
plot(g)