epidemics_with_dates.R

#### Handling dates in epidemics ####
library(ggplot2)
library(dplyr)
library(tidyr)
library(purrr)

contact_matrix <- matrix(1)
demography_vector <- c(10e6)

# make initial conditions - order is important
initial_conditions <- matrix(
  c(S = 1 - 1e-6, E = 0, I = 1e-6, R = 0, V = 0),
  nrow = 1, byrow = FALSE
)

# create a population
pop <- population(
  contact_matrix = contact_matrix,
  demography_vector = demography_vector,
  initial_conditions = initial_conditions
)

# assign six month period
today = Sys.Date()
duration = 360
start_times = withr::with_seed(1, rnbinom(100, 1, 0.05))

# with multiple start and end dates
data <- model_default(
  pop,
  transmission_rate = 1.5 / 7.0, # R0 = 2.0
  start_date = today + start_times,
  duration = duration - start_times
)

# combine data and count infections by epiweek
data_combined = dplyr::select(data, param_set, data) |> 
  dplyr::mutate(
    data = purrr::map(data, new_infections)
  ) |> 
  tidyr::unnest(data) |> 
  mutate(
    epiweek = lubridate::epiweek(date)
  ) |> 
  summarise(
    weekly_infections = sum(new_infections),
    .by = c("param_set", "epiweek")
  )


ggplot(data_combined) +
  geom_line(
    aes(epiweek, weekly_infections, group = param_set),
    alpha = 0.5
  )