Skip to content
Snippets Groups Projects
title: "sirPLUS models"
date: "Last updated: 23 March 2020"
output:
    BiocStyle::html_document:
        toc: true
        toc_float: true
vignette: >
  %\VignetteIndexEntry{sirPLUS models}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

Backgrouund on the SEIQHRF (SIR + extra compartments) model

Based on Tim Churches"'" blog post.

COVID-19 transition diagram Note the lower case letters between compartment nodes represent model input parameters defined in the blog post

Sett up environment and pull parameters

library(tidyverse)
library(dplyr)
library(magrittr)
library(lubridate)
library(stringr)
library(tibble)
library(broom)
library(ggplot2)
#remotes::install_github("rstudio/gt")
library(gt)
library(knitr)
library(devtools)
library(DiagrammeR)
library(parallel)
library(foreach)
library(tictoc)
suppressMessages(library(EpiModel))
library(incidence)
.libPaths('/mnt/mcfiles/rlyu/Software/R/3.6/Rlib')
#devtools::install_github("reconhub/earlyR")
library(earlyR)

tic("Time to complete")
source_files <- c("_icm.mod.init.seiqhrf.R", "_icm.mod.status.seiqhrf.R", 
    "_icm.mod.vital.seiqhrf.R", "_icm.control.seiqhrf.R", "_icm.utils.seiqhrf.R", 
    "_icm.saveout.seiqhrf.R", "_icm.icm.seiqhrf.R")

src_path <- paste0("./_posts/2020-03-18-modelling-the-effects-of-public-health-", 
    "interventions-on-covid-19-transmission-part-2/")

gist_url <- "https://gist.github.com/timchurches/92073d0ea75cfbd387f91f7c6e624bd7"

local_source <- FALSE

for (source_file in source_files) {
    if (local_source) {
        source(paste(src_path, source_file, sep = ""))
    } else {
        Sys.sleep(1)
        source_gist(gist_url, filename = source_file)
    }
}

Define Functions

# function to set-up and run the baseline simulations
devtools::load_all(".")
control <- set.control()
param <- set.param()
init <- set.init(s.num = 10000, e.num = 150, q.num = 10, h.num = 0)
init

sim <- icm.seiqhrf(param, init, control)
sim_df <- as.data.frame(sim, out=out)
simulate <- list(sim=sim, df=sim_df)

Generate and inspect baseline simulations

started at 3:12 pm

baseline_sim <- simulate(ncores = 4)
times <- get_times(baseline_sim)

times %>% filter(duration <= 30) %>% ggplot(aes(x = duration)) + 
    geom_bar() + facet_grid(period_type ~ ., scales = "free_y") + 
    labs(title = "Duration frequency distributions", subtitle = "Baseline simulation")
baseline_plot_df <- baseline_sim$df %>% # use only the prevalence columns
select(time, s.num, e.num, i.num, q.num, h.num, r.num, f.num) %>% 
    # examine only the first 100 days since it is all over by
# then using the default parameters
filter(time <= 100) %>% pivot_longer(-c(time), names_to = "compartment", 
    values_to = "count")

# define a standard set of colours to represent compartments
compcols <- c(s.num = "yellow", e.num = "orange", i.num = "red", 
    q.num = "cyan", h.num = "magenta", r.num = "lightgreen", 
    f.num = "black")
complabels <- c(s.num = "Susceptible", e.num = "Infected/asymptomatic", 
    i.num = "Infected/infectious", q.num = "Self-isolated", h.num = "Requires hospitalisation", 
    r.num = "Recovered", f.num = "Case fatality")

baseline_plot_df %>% ggplot(aes(x = time, y = count, colour = compartment)) + 
    geom_line(size = 2, alpha = 0.7) + scale_colour_manual(values = compcols, 
    labels = complabels) + theme_dark() + labs(title = "Baseline simulation", 
    x = "Days since beginning of epidemic", y = "Prevalence (persons)")

Experiment 1