Simulating Coronavirus Progression and Public Health Interventions with R and Shiny

Introducing Coronavirus SimulateR

Introduction

I wrote a Shiny app to simulate Coronavirus disease progression in a population, and to test the effects of public health measures like quarantining and social isolation!

The code is based heavily on a series of posts by Tim Churches: Modelling the effects of public health interventions on COVID-19 transmission using R.

Tim’s code, in turn, relies heavily on the package EpiModel: An R Package for Mathematical Modeling of Infectious Disease over Networks1.

The first tab lets you explore the base Susceptible, Infectious, Recovered (SIR) epidemiological model.

The SIR Model

Wikipedia

The second tab uses extensions to the SIR model that Tim has written to better model COVID-19, including the addition of new compartments.

Transition Diagram for SIR Model Extensions

Tim Churches

Example Use

Use it to simulate the effects of public policy interventions proposed by our public officials!

Here is the baseline simulation, with no intervention.

simulate() %>% ggplot(...) + ...

Over the course of 100 days the population transitions from susceptible to recovered.

With the susceptible and infected compartments removed.

The goal of public policy interventions is to reduce case fatalities.

For example, one such intervention is increasing the self-isolation rate. The increased self-isolation rate could be a reflection of increased community awareness or a stay at home order (such as the one issued by governor Hogan). In the extended SIR model, this affects the rate at which subjects transition between the Infected and Self-Isolated compartments (see the transition diagram above). The code below increases the rate from the default of 0.0333 to a rate of 0.5 between days 15 and 30 and runs the simulation.

quar_rate_ramp <- function(t) {
    ifelse(t < 15, 0.0333, ifelse(t <= 30, 0.0333 + (t - 15) * 
        (0.5 - 0.0333)/15, 0.5))
}

simulate(quar.rate = quar_rate_ramp(1:100)) %>% ggplot(...) + ...

You can see that this intervention does “flatten the curve” of infected, and significantly reduces case fatalities.

However, I believe Trump’s plan is a temporary self-isolation measure. The code below increases the self-isolation rate from 0.0333 to 0.5 between days 15 and 30, and returns the rate to the baseline 0.0333 at day 31.

quar_rate_ramp_end <- function(t) {
    ifelse(t < 15, 0.0333, 
    ifelse(t <= 30, 0.0333 + (t - 15) * (0.5 - 0.0333)/15, 
    0.0333))
}

simulate(quar.rate = quar_rate_ramp_end(1:100)) %>% ggplot(...) + ...

You can see that the danger of a temporary quarantine is, as many have pointed out, that it may lead to a secondary spike that is almost as great as the initial spike would have been, with only a slight reduction in case fatalities compared to the baseline condition.

Ah, but trump also mentioned increasing ICU capacity. How much does that help? The code below adds an increase in hospital capacity between days 15 and 45 to the model.

hosp <- function(t) {
    ifelse(t < 15, 40, 
    ifelse(t <= 45, 40 + (t - 15) * (120 - 40)/30, 
    120))
}

quar <- function(t) {
    ifelse(t < 15, 0.0333, 
    ifelse(t <= 30, 0.0333 + (t - 15) * (0.5 - 0.0333)/15, 
    0.0333))
}

simulate(quar.rate = quar(1:100), hosp.cap = hosp(1:100)) %>% ggplot(...) + ...

Not much …

Conclusions

  • Public health measures, such as quarantining and social isolation, do save lives,
    • but only if maintained long enough to truly “flatten the curve.”
  • Increasing ICU capacity doesn’t help if the healthcare system is still overwhelmed.

Coronavirus SimulateR

(see my shiny server for the full-page app)


  1. EpiModel: An R Package for Mathematical Modeling of Infectious Disease over Networks. Jenness, S., Goodreau, S. and Morris, M., 2018. Journal of Statistical Software, Vol 84(8), pp. 1-47. DOI: 10.18637/jss.v084.i08

comments powered by Disqus