Medicine on R Views

Multistate Models for Medical Applications

Wed, 19 Apr 2023 00:00:00 +0000

Clinical research studies and healthcare economics studies are frequently concerned with assessing the prognosis for survival in circumstances where patients suffer from a disease that progresses from state to state. Standard survival models only directly model two states: alive and dead. Multi-state models enable directly modeling disease progression where patients are observed to be in various states of health or disease at random intervals, but for which, except for death, the times of entering or leaving states are unknown. Multi-state models easily accommodate interval censored intermediate states while making the usual assumption that death times are known but may be right censored.

A natural way to conceptualize modeling the dynamics of disease progression with interval censored states is as continuous time Markov chains. The following diagram illustrates a possible disease progression model where there is some possibility of dying from any state, but otherwise a patient would progress from being healthy, to mild disease, to severe disease and then perhaps death.

## Loading required package: shape

It is true that in that the Markov assumption implies that the time patients spend in the various states are exponentially distributed. However, the mathematical theory of stochastic multi-state processes is very rich and can accommodate more realistic models with state dependent hazard rates that vary over time and other relaxations of the Markov assumption. Moreover, there is robust software in R (and other languages) that make multi-state stochastic survival models practical.

In the remainder of this post, I present a variation of a disease progression model discussed by Ardo van den Hout in some detail in his incredibly informative and very readable monograph Multi-State Survival Models for Interval Censored Data . Also note that van den Hout’s model is itself an elaboration of the main example presented by Christopher Jackson in the vignette to his msmpackage. This post presents a slower development of the model developed by Jackson and van den Hout that might be easier for a person not already familiar with the msm package to follow.

library(tidyverse)
library(tidymodels)
library(msm)

The Data

The data set explored by both Jackson and van den Hout is the Cardiac Allograft Vasculopathy (CAV) data set which contains the individual histories of angiographic examinations of 622 heart transplant recipients collected at the Papworth Hospital in the United Kingdom. This data is included in the msm package and is a good candidate to be the iris dataset for progressive disease models. It is a rich data set with 2846 rows and multiple covariates, including patient age and time time since transplant, both of which can be use for time scales, multiple state transitions among four states and no missing values. Observations of intermediate states are interval censored and have been recorded varying time intervals. Deaths are “exact” or right censored.

The following code creates a new variable that preserves the original state data for each observation and displays the data in tibble format.

set.seed(1234)
df <- tibble(cav) %>% mutate(o_state = state)

df

## # A tibble: 2,846 × 11
##     PTNUM   age years  dage   sex pdiag cumrej state firstobs statemax o_state
##     <int> <dbl> <dbl> <int> <int> <fct>  <int> <int>    <int>    <dbl>   <int>
##  1 100002  52.5  0       21     0 IHD        0     1        1        1       1
##  2 100002  53.5  1.00    21     0 IHD        2     1        0        1       1
##  3 100002  54.5  2.00    21     0 IHD        2     2        0        2       2
##  4 100002  55.6  3.09    21     0 IHD        2     2        0        2       2
##  5 100002  56.5  4       21     0 IHD        3     2        0        2       2
##  6 100002  57.5  5.00    21     0 IHD        3     3        0        3       3
##  7 100002  58.4  5.85    21     0 IHD        3     4        0        4       4
##  8 100003  29.5  0       17     0 IHD        0     1        1        1       1
##  9 100003  30.7  1.19    17     0 IHD        1     1        0        1       1
## 10 100003  31.5  2.01    17     0 IHD        1     3        0        3       3
## # ℹ 2,836 more rows

The state table which presents the number of times each pair of states were observed in successive observation times shows that 46 transitions from state 2 (Mild CAV) to state 1 (No CAV), 4 transitions from state 3 (Severe CAV) to Healthy and 13 transitions from Severe CAV to Mild CAV.

statetable.msm(state = state, subject = PTNUM, data = df)

##     to
## from    1    2    3    4
##    1 1367  204   44  148
##    2   46  134   54   48
##    3    4   13  107   55

I will follow van den Hout and assume these backward transitions are misclassified and alter the state variable so there is no back sliding. The following code does this in a tidy way and also creates a new variable b_age which records the baseline age at which patients entered the study. (Note: you can find van den Hout’s code here)

df1 <- df %>% group_by(PTNUM) %>% 
                     mutate(b_age = min(age),
                            state = cummax(state)
                     )

This transformation will make the state transition table conform to the diagram above, but with state 1 representing No CAV rather than Health.

statetable.msm(state = state, subject = PTNUM, data = df1)

##     to
## from    1    2    3    4
##    1 1336  185   40  139
##    2    0  220   52   49
##    3    0    0  140   63

Setting Up and Running the Model

The next step is to set up the model using the function msm() whose great flexibility means that some care must be taken to set parameter values.

First, we set up the initial guess for the intensity matrix, Q, which determines the transition rates among states for a continuous time Markov chain. For the msm function, positive values indicate possible transitions.

# Intensity matrix Q:
q <- 0.01
Q <- rbind(c(0,q,0,q), c(0,0,q,q),c(0,0,0,q),c(0,0,0,0))
qnames <- c("q12","q14","q23","q24","q34")

Next, we set up the covariate structure which van den Hout discusses in his monograph, but does not show in the code on the book’s website referenced above. For this model, transitions from state 1 to state 2 and from state 1 to state 4 depend on time,years, the age of the patient at transplant time b_age, and dage, the age of the donor. The other transitions depend only on dage. So, we see that msm() can deal with time varying covariates as well as permitting individual state transitions to be driven by different covariates.

covariates = list("1-2" = ~ years + b_age + dage , 
                  "1-4" = ~ years + b_age + dage ,
                  "2-3" = ~ dage,
                  "2-4" = ~ dage,
                  "3-4" = ~ dage)

Now, we set the remaining parameters for the model.

obstype <- 1
center <- FALSE
deathexact <- TRUE
method <- "BFGS"
control <- list(trace = 0, REPORT = 1)

obstype = 1 indicates that observations have been taken at arbitrary time points. They are snapshots of the process that are common for panel data.

center = FALSE means that covariates will not be centered at their means during the maximum likelihood estimation process. The default for this parameter is TRUE.

deathexact = TRUE indicates that the final absorbing state is exactly observed. This is the defining assumption survival data. In msm this is equivalent to setting obstupe = 3 for state 4, our absorbing state.

** method = BFGS** signals optim() to use the optimization method published simultaneously in 1970 by Broyden, Fletcher, Goldfarb and Shanno. (look here). This is a quasi-Newton method that uses function values and gradients to build up a picture of the surface to be optimized.

control = list(trace=0,REPORT=1) indicates more parameters that will be passed to optim().

REPORT sets the the frequency of reports for the “BFGS”, “L-BFGS-B” and “SANN” methods if control$trace is positive. Defaults to every 10 iterations for “BFGS” and “L-BFGS-B”, or every 100 temperatures for “SANN”. (Note: SANN is a variant of the simulated annealing method presented by C. J. P. Belisle (1992) Convergence theorems for a class of simulated annealing algorithms on R^d Journal of Applied Probability.)

trace is also passed tooptim(). trace must be a non-negative integer. If positive, tracing information on the progress of the optimization is produced. Higher values may produce more tracing information.

model_1 <- msm(state~years, subject = PTNUM, data = df1, center= center, 
             qmatrix=Q, obstype = obstype, deathexact = deathexact, method = method,
             covariates = covariates, control = control)

First check to see if the model has converged. For the BFGS method, possible convergence codes returned by optim() are: 0 indicates convergence, 1 indicates that the maximum iteration limit has been reached, 51 and 52 indicate warnings.

#Model Status
conv <- model_1$opt$convergence; cat("Convergence code =", conv,"\n")

## Convergence code = 0

Next, look at a measure of how well the model fits the data proposed by using a visual test proposed by Gentleman et al. (1994) which plots the observed numbers of individuals occupying a state at a series of times against forecasts from the fitted model, for each state. The msm function plot.prevalence.msm() produces a perfectly adequate base R plot. However, to emphasize that msm users are not limited to base R plots, I’ll do a little extra work to use ggplot(). When a package author is kind enough to provide an extractor function you can do anything you want with the data.

The prevalence.msm() function extracts both the observed and forecast prevalence matrices.

prev <- prevalence.msm(model_1)

This not very elegant, but straightforward code reshapes the data and plots.

# reshape observed prevalence
do1 <-as_tibble(row.names(prev$Observed)) %>% rename(time = value) %>% 
          mutate(time = as.numeric(time))
do2 <-as_tibble(prev$Observed) %>% mutate(type = "observed")
do <- cbind(do1,do2) %>% select(-Total)
do_l <- do %>% gather(state, number, -time, -type)
# reshape expected prevalence
de1 <-as_tibble(row.names(prev$Expected)) %>% rename(time = value) %>% 
          mutate(time = as.numeric(time))
de2 <-as_tibble(prev$Expected) %>% mutate(type = "expected")
de <- cbind(de1,de2) %>% select(-Total) 
de_l <- de %>% gather(state, number, -time, -type) 

# bind into a single data frame
prev_l <-rbind(do_l,de_l) %>% mutate(type = factor(type),
                                     state = factor(state),
                                     time = round(time,3))


# plot for comparison
prev_gp <- prev_l %>% group_by(state)
pp <- prev_l %>% ggplot() +
     geom_line(aes(time, number, color = type)) +
     xlab("time") +
     ylab("") +
     ggtitle("")
pp + facet_wrap(~state)

The agreement of the observed and forecast prevalence for states 1 through 3 look pretty good. After about 8 years the observed deaths are notably higher than the forecast. As Jackson points out (See the msm Manual page 33), this kind of discrepancy could indicate that the underlying process is not homogeneous. I have attempted to capture this non-homogeneity by having some of the transitions depend on time. And, although the plot above looks a little better that than the plot in the manual, which does not attempt to model non-homogeneity, it is apparent that there is room to find a better model!

Survival Curves and Calculations

Now, we can jump straight to the major result and look at the fitted survival curves. There is a plot() method for msm that will directly plot these curves. However, just to emphasize that if a package author is kind enough to provide a plot method, it will probably not be too difficult to hack the code for the method to use an alternative plotting system. To save space, I will not show my code, but you can easily recreate it by stating with the plot.msm() function, deleting the plotting parts and returning the values for time and the states “Health, Mild_CAV, and Severe_CAV which are used int the code below. Check my hack by running plot(model_1)

# plot_prep was obtained from plot.msm()
res <- plot_prep(model_1)
time <- res[[1]]
Health <- res[[2]]
Mild_CAV <- res[[3]]
Severe_CAV <- res[[4]]
df_w <- tibble(time,Health, Mild_CAV, Severe_CAV)
df_l <- df_w %>% gather("state", "survival", -time)
p <- df_l %>% ggplot(aes(time, 1 - survival, group = state)) +
     geom_line(aes(color = state)) +
     xlab("Years") +
     ylab("Probability") +
     ggtitle("Fitted Survival Probabilities")
p

These curves indicate that a treatment that could prevent CAV or at least delay progression from mild CAV to severe CAV might prolong survival. Additionally, the Markov structure of the model permits extracting information that relates to disease progression and the total time spent in each state.

The function totlos.msm() estimates the total expected time that a patient will spend in each state. Parameter settings for this function include:

start = c(1,0,0,0) specifies that patients will start in state 1 with probability 0.

fromt = 0 indicates starting at the beginning of the process.

covariates = “mean” indicates that the covariates will be set to their mean values for the calculation.

total_state_time <-totlos.msm(model_1,start = c(1,0,0,0), from = 0, covariates = "mean")
total_state_time

## State 1 State 2 State 3 State 4 
##   7.002   2.473   1.621     Inf

The table indicates that the mean time a patient can expect to avoid CAV is about 7 years. After progressing to a Mild_CAV, a patient can expect five additional years.

A more direct calculation based on the intensity matrix, Q, give the expected time to the “absorbing” state, Death, from each of the “transient” living states.

time_to_death <- efpt.msm(model_1, tostate = 4, covariates = "mean")
time_to_death

## [1] 11.097  5.836  3.005  0.000

This agrees with the total state times calculated above.

sum(total_state_time[1:3])

## [1] 11.1

Within the scope of the information provided by the covariates, it is also possible to generate more individualized forecasts. For example, here is the expected time to death for a person starting off with no CAV at age 60, who received a heart from a 20 year old donor, 5 years after the transplant.

efpt.msm(model_1, tostate = 4, start = c(1,0,0,0), covariates = list(years = 5, b_age = 60, dage = 20))

##       [,1]
## [1,] 7.953

A related quantity, mean sojourn time, is the mean time that each visit to each state is expected to last. Since, we are assuming a progressive disease model where each patient visits each state only once, the estimate should be close to total time spent in each state. However, Jackson notes that in a progressive model, sojourn time in the disease state will be greater than the expected length of stay in the disease state because the mean sojourn time in a state is conditional on entering the state, whereas the expected total time in a diseased state is a forecast for an individual, who may die before getting the disease. (See help(totlos.msm)). And indeed, that is what we see here for states 2 and 3.

sojourn.msm(model_1, covariates="mean")

##         estimates     SE     L     U
## State 1     7.002 0.4024 6.256 7.837
## State 2     3.525 0.3020 2.980 4.169
## State 3     3.005 0.3748 2.353 3.837

Hazard Ratios

model_1 will also product estimates of hazard ratios which show the estimate effect on transition intensities for each state.

Here is the table of Hazard Ratios:

model_1

## 
## Call:
## msm(formula = state ~ years, subject = PTNUM, data = df1, qmatrix = Q,     obstype = obstype, covariates = covariates, deathexact = deathexact,     center = center, method = method, control = control)
## 
## Maximum likelihood estimates
## Baselines are with covariates set to 0
## 
## Transition intensities with hazard ratios for each covariate
##                   Baseline                         years              
## State 1 - State 1 -0.032750 (-0.0607897,-0.017644)                    
## State 1 - State 2  0.030957 ( 0.0160470, 0.059721) 1.112 (1.061,1.166)
## State 1 - State 4  0.001793 ( 0.0004703, 0.006836) 1.093 (1.012,1.182)
## State 2 - State 2 -0.395633 (-0.6488723,-0.241227)                    
## State 2 - State 3  0.264310 ( 0.1488153, 0.469441) 1.000              
## State 2 - State 4  0.131323 ( 0.0330133, 0.522385) 1.000              
## State 3 - State 3 -0.434548 (-0.9113857,-0.207192)                    
## State 3 - State 4  0.434548 ( 0.2071918, 0.911386) 1.000              
##                   b_age                dage                 
## State 1 - State 1                                           
## State 1 - State 2 1.001 (0.9884,1.014) 1.0281 (1.0159,1.040)
## State 1 - State 4 1.053 (1.0271,1.079) 1.0208 (1.0039,1.038)
## State 2 - State 2                                           
## State 2 - State 3 1.000                0.9932 (0.9756,1.011)
## State 2 - State 4 1.000                0.9757 (0.9298,1.024)
## State 3 - State 3                                           
## State 3 - State 4 1.000                0.9906 (0.9672,1.015)
## 
## -2 * log-likelihood:  3466

The table shows that time, the covariate years, affects disease progression represented by the the transition from state 1 to state 2, but has a smaller effect on the transition from state 1 to state 4.

The covariate b_age, the baseline age of patient at transplant time has a larger effect on dying before the onset of CAV than on the transition to CAV.

The covariate dage has a minor effect on the transitions from state 1 but apparently has no effect thereafter.

The hazard ratios are computed by calculating the exponential of the estimated covariate effects on the log-transition intensities for the Markov process which are stored in the model object.

To see how these work, first look at the baseline hazard ratios.

model_1$Qmatrices$baseline

##          State 1  State 2 State 3  State 4
## State 1 -0.03275  0.03096  0.0000 0.001793
## State 2  0.00000 -0.39563  0.2643 0.131323
## State 3  0.00000  0.00000 -0.4345 0.434548
## State 4  0.00000  0.00000  0.0000 0.000000

These baseline hazard ratios are computed from the model intensity matrix, Q, assuming no covariates. They can also be directly extracted from the model by qmatrix.msm() extractor function with covariates set to zero.

qmatrix.msm(model_1,  covariates = 0)

##         State 1                          State 2                         
## State 1 -0.032750 (-0.0607897,-0.017644)  0.030957 ( 0.0160470, 0.059721)
## State 2 0                                -0.395633 (-0.6488723,-0.241227)
## State 3 0                                0                               
## State 4 0                                0                               
##         State 3                          State 4                         
## State 1 0                                 0.001793 ( 0.0004703, 0.006836)
## State 2  0.264310 ( 0.1488153, 0.469441)  0.131323 ( 0.0330133, 0.522385)
## State 3 -0.434548 (-0.9113857,-0.207192)  0.434548 ( 0.2071918, 0.911386)
## State 4 0                                0

The 95% confidence limits are computed by assuming normality of the log-effect.

A more representative value for the intensity matrix for this model can be obtained by setting the covariates to their expected mean values.

qmatrix.msm(model_1,  covariates = "mean")

##         State 1                      State 2                     
## State 1 -0.14281 (-0.15984,-0.12760)  0.10019 ( 0.08742, 0.11482)
## State 2 0                            -0.28369 (-0.33556,-0.23984)
## State 3 0                            0                           
## State 4 0                            0                           
##         State 3                      State 4                     
## State 1 0                             0.04262 ( 0.03339, 0.05441)
## State 2  0.21821 ( 0.17636, 0.26999)  0.06548 ( 0.03872, 0.11075)
## State 3 -0.33281 (-0.42498,-0.26064)  0.33281 ( 0.26064, 0.42498)
## State 4 0                            0

Next, we may want to examine the contribution of the covariate covariates to the hazard ratios. To take a particular example, look at the dage to the hazard ratios

model_1$Qmatrices$dage

##         State 1 State 2   State 3   State 4
## State 1       0 0.02771  0.000000  0.020575
## State 2       0 0.00000 -0.006783 -0.024625
## State 3       0 0.00000  0.000000 -0.009439
## State 4       0 0.00000  0.000000  0.000000

and focus on the contribution of dage to the intensity matrix for the transition from state 3 to state 4 which is given as -0.009439 in the table above. Taking the exponential of this value, yields the hazard ratio for the dage state 3 to 4 transition in the hazard ratio’s table we got by printing out model_1 above.

exp(-.009439)

## [1] 0.9906

The hazard ratio tables for the remaining covariates are given by:

model_1$Qmatrices$years

##         State 1 State 2 State 3 State 4
## State 1       0  0.1064       0 0.08933
## State 2       0  0.0000       0 0.00000
## State 3       0  0.0000       0 0.00000
## State 4       0  0.0000       0 0.00000

and

model_1$Qmatrices$b_age

##         State 1   State 2 State 3 State 4
## State 1       0 0.0009645       0 0.05152
## State 2       0 0.0000000       0 0.00000
## State 3       0 0.0000000       0 0.00000
## State 4       0 0.0000000       0 0.00000

Exploring Transition Probabilities and Intensities

It is also possible to look at the state transition matrix at different times and see how these probabilities change over time. Here we compute the transition matrix at 1 year.

pmatrix.msm(model_1, t = 1, covariates = "mean")

##         State 1 State 2  State 3 State 4
## State 1  0.8669 0.08101 0.008493 0.04357
## State 2  0.0000 0.75300 0.160340 0.08666
## State 3  0.0000 0.00000 0.716903 0.28310
## State 4  0.0000 0.00000 0.000000 1.00000

and at 5 years.

pmatrix.msm(model_1, t = 5, covariates = "mean")

##         State 1 State 2 State 3 State 4
## State 1  0.4897  0.1761 0.07871  0.2556
## State 2  0.0000  0.2421 0.23419  0.5237
## State 3  0.0000  0.0000 0.18937  0.8106
## State 4  0.0000  0.0000 0.00000  1.0000

Additionally, it is possible to examine the effect of covariates on transition probabilities. Here are the 5 year transition probabilities for a patient with a baseline age of 35.

pmatrix.msm(model_1, t = 5, covariates = list(years = 5, b_age = 35, dage = 20))

##         State 1 State 2 State 3 State 4
## State 1  0.5474  0.1674 0.07575  0.2095
## State 2  0.0000  0.2112 0.21622  0.5726
## State 3  0.0000  0.0000 0.16547  0.8345
## State 4  0.0000  0.0000 0.00000  1.0000

and those who had the procedure at age 60.

pmatrix.msm(model_1, t = 5, covariates = list(years = 5, b_age = 60, dage = 20))

##         State 1 State 2 State 3 State 4
## State 1  0.3863  0.1409 0.06784  0.4050
## State 2  0.0000  0.2112 0.21622  0.5726
## State 3  0.0000  0.0000 0.16547  0.8345
## State 4  0.0000  0.0000 0.00000  1.0000

Note that the transitions from CAV states are unaffected.

To summarize: Continuous Time Markov Chains provide a natural framework for working with multi-state survival models. The msm package is sufficiently sophisticated to permit modeling clinical process with level of fidelity that may provide insight about clinically observed disease progression. The software is relatively easy to use and there is plenty of documentation to help you get started.

Learning More About Multi-State Survival Models

To dive deeper into multi-state survival models, I am sure you will find Ardo van den Hout’ Multi-State Survival Models for Interval-Censored Data extraordinarily helpful. There are many good textbooks about the basics of Continuous Time Markov Chains. I recommend J.R.Norris’ - Markov Chains which is still modestly priced. There are also many expositions freely available on the internet including:

David F. Anderson - Chapter 6: Continuous Time Markov Chains from Lecture Notes on Stochastic Processes with Applications in Biology
Miranda Holmes-Cerfon - Lecture 4: Continuous-time Markov Chains
Søren Feodor Nielsen - Continuous-time homogeneous Markov chains
Karl Sigman - Continuous-Time Markov Chains

The COVID19 package, an interface to the COVID-19 Data Hub

Wed, 08 Dec 2021 00:00:00 +0000

The COVID-19 Data Hub provides a daily summary of COVID-19 cases, deaths, recovered, tests, vaccinations, and hospitalizations for 230+ countries, 760+ regions, and 12000+ administrative divisions of lower level. It includes policy measures, mobility, and geospatial data. This post presents version 3.0.0 of the COVID19 package to seamlessly import the data in R.

Why another package for COVID-19 data

Many packages now exist to retrieve COVID-19 related data from within R. As an example, covid19br retrieves case data for Brazil, covid19sf for San Francisco, covid19us for United States, covid19india for India, covid19italy for Italy, covid19swiss for Switzerland, covid19france for France, and so on. There also other packages, such as coronavirus, that retrieve national-level statistics worldwide from the Center for Systems Science and Engineering at Johns Hopkins University (JHU CCSE). However, national counts only represent a small portion of the available governmental data, and having the information scattered across many packages and different interfaces makes international comparisons of large, detailed outbreak data difficult, and prevents inferences from such data to be effective.

COVID19 is the official package created around COVID-19 Data Hub: a unified database harmonizing open governmental data around the globe at fine-grained spatial resolution. Moreover, as epidemiological data alone are typically of limited use, the database includes a set of identifiers to match the epidemiological data with exogenous indicators and geospatial information. By unifying the access to the data, this database makes it possible to study the pandemic in its global scale with high resolution, taking into account within-country variations, non pharmaceutical interventions, and environmental and exogenous variables.

In particular, this package allows you to download a large set of epidemiological variables, exogenous indicators from World Bank, mobility data from Google and Apple mobility reports, and geospatial information from Eurostat for Europe or GADM worldwide, in, literally, one line of code.

What’s new in version 3.0.0

Version 3 is a major update of COVID-19 Data Hub, which includes a great improvement in the spatial coverage, new data on vaccines, and a new set of identifiers to enable geospatial analyses. The full changelog is available here.

The large amount of data that is now available (~2GB) has led to some breaking changes in the way the data are provided. Version 3 of the COVID19 package is designed to be compatible with the latest version of COVID-19 Data Hub, and process large amount of data at speed with low memory requirements. The documentation and a quick start guide is available here.

Data coverage

The figure shows the granularity and the spatial coverage of the data as of November 27, 2021.

What’s included?

library(COVID19)  # load the package
x <- covid19()    # download the data

Refer to the documentation for the description of each variable.

colnames(x)

##  [1] "id"                                  "date"                               
##  [3] "confirmed"                           "deaths"                             
##  [5] "recovered"                           "tests"                              
##  [7] "vaccines"                            "people_vaccinated"                  
##  [9] "people_fully_vaccinated"             "hosp"                               
## [11] "icu"                                 "vent"                               
## [13] "school_closing"                      "workplace_closing"                  
## [15] "cancel_events"                       "gatherings_restrictions"            
## [17] "transport_closing"                   "stay_home_restrictions"             
## [19] "internal_movement_restrictions"      "international_movement_restrictions"
## [21] "information_campaigns"               "testing_policy"                     
## [23] "contact_tracing"                     "facial_coverings"                   
## [25] "vaccination_policy"                  "elderly_people_protection"          
## [27] "government_response_index"           "stringency_index"                   
## [29] "containment_health_index"            "economic_support_index"             
## [31] "administrative_area_level"           "administrative_area_level_1"        
## [33] "administrative_area_level_2"         "administrative_area_level_3"        
## [35] "latitude"                            "longitude"                          
## [37] "population"                          "iso_alpha_3"                        
## [39] "iso_alpha_2"                         "iso_numeric"                        
## [41] "iso_currency"                        "key_local"                          
## [43] "key_google_mobility"                 "key_apple_mobility"                 
## [45] "key_jhu_csse"                        "key_nuts"                           
## [47] "key_gadm"

Data transparency

This package applies no pre-processing to the original data, that are provided as-is. The data acquisition pipeline is open source and all the original data providers are listed here.

As an example, the following code snippet plots the fraction of confirmed cases on a given day per number of tests performed on that day in U.S. Notice that around June 2021, the fraction becomes negative. This is a known issue due to decreasing cumulative counts in the original data provider. This package applies no cleaning procedure for this kind of issues, which are typically due to changes in the data collection methodology. If the provider corrects the data retroactively, the changes are reflected in this package.

library(xts)
library(dygraphs)
x <- covid19("USA", verbose = FALSE)  # download the data
ts <- xts(x[,c("confirmed", "tests")], order.by = x$date)  # convert to an xts object
ts$ratio <- diff(ts$confirmed) / diff(ts$tests)  # compute daily ratio
dygraph(ts$ratio, main = "Daily fraction confirmed/tests in U.S.")  # plot

World Bank data

Country-level covariates by World Bank Open Data can be easily added. Refer to the table at the bottom of this page for relevant indicators. The following code snippet shows e.g., how to download the number of hospital beds for each country. Refer to the quickstart guide for more details.

x <- covid19(wb = c("hosp_beds" = "SH.MED.BEDS.ZS"), verbose = FALSE)

Mobility data

Mobility data are obtained from Google and Apple mobility reports. The following example shows how to download the data by Google. Refer to the quickstart guide for Apple’s reports and for more details.

x <- covid19(gmr = TRUE, verbose = FALSE)
colnames(x[,48:53])

## [1] "retail_and_recreation_percent_change_from_baseline"
## [2] "grocery_and_pharmacy_percent_change_from_baseline" 
## [3] "parks_percent_change_from_baseline"                
## [4] "transit_stations_percent_change_from_baseline"     
## [5] "workplaces_percent_change_from_baseline"           
## [6] "residential_percent_change_from_baseline"

Spatial data

The dataset contains NUTS codes to match the Eurostat database for Europe, and GID codes to match the GADM worldwide database. The following example shows how to access spatial data using GADM for U.S. counties. Similar maps are available worldwide for most other countries at the various granularity levels.

First, download level 3 data for U.S.

x <- covid19("USA", level = 3, verbose = FALSE)

GADM data by country can be found here. Download the geopackage for U.S. using GADM version 3.6:

url <- "https://biogeo.ucdavis.edu/data/gadm3.6/gpkg/gadm36_USA_gpkg.zip"
zip <- tempfile()
download.file(url, destfile = zip)

Unzip the geopackage:

exdir <- tempfile()
unzip(zip, exdir = exdir)

Load the sf package and list the layers:

library(sf)
file <- paste0(exdir, "/gadm36_USA.gpkg")
st_layers(file)

## Driver: GPKG 
## Available layers:
##     layer_name geometry_type features fields
## 1 gadm36_USA_2 Multi Polygon     3148     13
## 2 gadm36_USA_1 Multi Polygon       51     10
## 3 gadm36_USA_0 Multi Polygon        1      2

Read layer 2 that corresponds to U.S. counties. Note: in general, there is not a perfect correspondence between GADM layers and the granularity level from this package. It is recommended to read all the layers, and match on the corresponding GID. Read more about how key_gadm from this package is mapped to the corresponding GID here.

g <- st_read(file, layer = "gadm36_USA_2")

## Reading layer `gadm36_USA_2' from data source 
##   `/private/var/folders/w0/skxpg0h51jg72m5b01y_8n_c0000gn/T/RtmpmUy7P6/file56232c611dfd/gadm36_USA.gpkg' 
##   using driver `GPKG'
## Simple feature collection with 3148 features and 13 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -179.2 ymin: 18.91 xmax: 179.8 ymax: 72.69
## Geodetic CRS:  WGS 84

Subset the data to extract only the counts as of, e.g., 15 November 2021. Select only the administrative divisions inside the following bounding box for better visualization.

x <- x[
  x$date == "2021-11-15" & 
  x$latitude > 24.9493 & x$latitude < 49.5904 &
  x$longitude > -125.0011 & x$longitude < -66.9326,]

Merge COVID-19 data with the spatial data:

library(dplyr)
gx <- right_join(g, x, by = c("GID_2" = "key_gadm"))

Plot e.g., the total number of confirmed cases:

plot(gx["confirmed"], logz = TRUE)

Academic publications

See the publications that use COVID-19 Data Hub.

Cite as

Guidotti, E., Ardia, D., (2020), “COVID-19 Data Hub”, Journal of Open Source Software 5(51):2376, doi: 10.21105/joss.02376.

A BibTeX entry for LaTeX users is

@Article{,
    title = {COVID-19 Data Hub},
    year = {2020},
    doi = {10.21105/joss.02376},
    author = {Emanuele Guidotti and David Ardia},
    journal = {Journal of Open Source Software},
    volume = {5},
    number = {51},
    pages = {2376}
}

Simulating COVID-19 interventions with R

Thu, 19 Mar 2020 00:00:00 +0000

Tim Churches is a Senior Research Fellow at the UNSW Medicine South Western Sydney Clinical School at Liverpool Hospital, and a health data scientist at the Ingham Institute for Applied Medical Research. This post examines simulation of COVID-19 spread using R, and how such simulations can be used to understand the effects of various public health interventions design to limit or slow its spread.

DISCLAIMER

The simulation results in this blog post, or any other results produced by the R code described in it, should not be used as actual estimates of mortality or any other aspect of the COVID-19 pandemic. The simulations are intended to explain principles, and permit exploration of the potential effects of various combinations and timings of interventions on spread. Furthermore, the code for these simulations has been written hurriedly over just a few days, it has not yet been peer-reviewed, and is considered alpha quality, and the simulation parameterisation presented here has not yet been validated against real-world COVID-19 data.

Introduction

In a previous post, we looked at the use of some R packages developed by the R Epidemics Consortium (RECON) to undertake epidemiological analyses COVID-19 incidence data scraped from various web sources.

Undertaking such value-adding analyses of COVID-19 incidence data, as the full horror of the pandemic unfolds, is a worthwhile endeavour. But it would also be useful to be able to gain a better understanding of the likely effects of various public health interventions on COVID-19 spread.

“Flattening-the-curve” infographics such as the one shown below are now everywhere. They are a useful and succinct way of communicating a key public health message – that social distancing and related measures will help take the strain off our health care systems in the coming months.

Source: Siouxsie Wiles and Toby Morris

However, as pointed out by several commentators, many of these infographics miss a crucial point: that public health measures can do more than just flatten the curve, they can also shrink it, thus reducing the total number of cases (and thus serious cases) of COVID-19 in a population, rather than just spread the same number of cases over a longer period such that the area under the curve remains the same.

This crucial point was beautifully illustrated using R in a post by Michael Höhle, which is highly recommended reading. Michael used a dynamic model of disease transmission, which is based on solving a system of ordinary differential equations (ODEs) with the tools found in base R.

Such mathematical approaches to disease outbreak simulation are elegant, and efficient to compute, but they can become unwieldy as the complexity of the model grows. An alternative is to use a more computational approach. In this post, we will briefly look at the individual contact model (ICM) simulation capability implemented in the excellent EpiModel package by Samuel Jenness and colleagues at the Emory University Rollins School of Public Health, and some extensions to it. Note also that this post is based on two more detailed posts that provide more technical details and access to relevant source code.

The `EpiModel` package

The EpiModel package provides facilities to explore three types of disease transmission model (or simulations): dynamic contact models (DCMs) as used by Michael Höhle, stochastic individual contact models (ICMs) and stochastic network models. The last are particularly interesting, as they can accurately model disease transmission with shifting social contact networks – they were developed to model HIV transmission, but have been used to model transmission of other diseases, including ebola, and even the propagation of memes in social media networks. These network models potentially have application to COVID-19 modelling – they could be used to model shifting household, workplace or school and wider community interactions, and thus opportunity for transmission of the virus. However, the networks models as currently implemented are not quite suitable for such purposes, modifying them is complex, and they are also very computationally intensive to run. For these reasons, we will focus on the simpler ICM simulation facilities provided by EpiModel.

Interested readers should consult the extensive tutorials and other documentation for EpiModel for a fuller treatment, but in a nutshell, an EpiModel ICM simulation starts with a hypothetical population of individuals who are permitted to be in one of several groups, or compartments, at any particular time. Out-of-the-box, EpiModel supports several types of models, including the popular SIR model which uses Susceptible, Infectious and Recovered compartments. At each time step of the simulation, individuals randomly encounter and are exposed to other individuals in the population. The intensity of this population mixing is controlled by an act rate parameter, with each “act” representing an opportunity for disease transmission, or at least those “acts” between susceptible individuals and infectious individuals. Recovered individuals are no longer infectious and are assumed to be immune from further re-infection, so we are not interested in their interactions with others, nor are we interested in interactions between pairs of susceptible individuals, only the interactions between susceptible and infectious individuals. However, not every such opportunity for disease transmission will result in actual disease transmission. The probability of transmission at each interaction is controlled by an infection probability parameter.

It is easy to see that decreasing the act.rate parameter is equivalent to increasing social distancing in the population, and decreasing the inf.prob parameter is equates to increased practice of hygiene measures such as hand washing, use of hand sanitisers, not touching one’s face, and mask wearing by the infectious. This was what I explored in some detail in my first personal blog post on simulating COVID-19 spread.

Extensions to `EpiModel`

However, the SIR model type is a bit too simplistic if we want to use the model to explore the potential effect of various public health measures on COVID-19 spread. Fortunately, EpiModel provides a plug-in architecture that allows more elaborate models to be implemented. The full details of my recent extensions to EpiModel can be found in my second personal blog post on COVID-19 simulation, but the gist of it is that several new compartment types were added, as shown in the table below, with support for transition between them as shown in the diagram below the table. The dashed lines indicate infection interactions.

Compartment	Functional definition
S	Susceptible individuals
E	Exposed and infected, not yet symptomatic but potentially infectious
I	Infected, symptomatic and infectious
Q	Infectious, but (self-)quarantined
H	Requiring hospitalisation (would normally be hospitalised if capacity available)
R	Recovered, immune from further infection
F	Case fatality (death due to COVID-19, not other causes)

Another capability that has been added is the ability to specify time-variant parameters, as a vector of the same length as there are time steps in the simulation. This allows us to smoothly (or step-wise) introduce, and withdraw, various interventions at arbitrary times during the course of our simulation.

We won’t cover here the details of how to obtain these extensions, which at the time of writing should still be considered alpha quality code – please see the blog post for those. Let’s just proceed to running some simulations.

Baseline simulation

First we’ll run a baseline simulation for a hypothetical population of 10,000 people, in which there are just three infectious COVID-19 cases at the outset. We’ll run it for 365 days, and we’ll set a very low rate at which infectious individuals enter self-quarantine (thereby dramatically lowering their rate of interactions with others) after they become symptomatic (or have been tested and found positive), and thus aware of their infectivity. Because it is stochastic, the simulation is run eight times, using parallel processing if available, and the results averaged.

tic()
baseline_sim <- simulate(ncores = 4)
toc()

## 58.092 sec elapsed

Let’s visualise the results as a set of time-series of the daily count of our 10,000 individuals in each compartment.

OK, that looks very reasonable. Note that almost the entire population ends up being infected. However, the S and R compartments dominate the plot (which is good, because it means humanity will survive!), so let’s re-plot leaving out those compartments so we can see a bit more detail.

Notice that the I compartment curve lags behind the E compartment curve – the lag is the incubation period, and that the Q curve lags still further as infected people only reluctantly and belatedly quarantine themselves (in this baseline scenario).

Running intervention experiments

Now we are in a position to run an experiment, by altering some parameters of our baseline model.

Let’s model the effect of decreasing the infection probability at each exposure event by smoothly decreasing the inf.prob parameters for the I compartment. The infection probability at each exposure event (for the I compartment individuals) starts at 5%, and we’ll reduce it to 2% between days 15 and 30. This models the effect of symptomatic infected people adopting better hygiene practices such as wearing masks, coughing into their elbows, using hand sanitisers, not shaking hands and so on, perhaps in response to a concerted public health advertising campaign by the government.

Let’s examine the results of experiment 1, alongside the baseline for comparison:

We can see from the plots on the left that by encouraging hygiene measures in symptomatic infectious individuals, we have not only substantially “flattened the curve”, but we have actually shrunk it. The result, as shown in the plots on the right, is that demand for hospital beds is substantially reduced, and only briefly exceeds our defined hospital capacity of 40 bed. This results in a substantially reduced mortality rate, shown by the black line.

More experiments

We can now embark on a series of experiments, exploring various interventions singly, or in combination, and with different timings.

Experiment 2

Let’s repeat experiment 1, but let’s delay the start of the hygiene campaign until day 30 and make it less intense so it takes until day 60 to achieve the desired increase in hygiene in the symptomatic infected.

infectious_hygiene_delayed_ramp <- function(t) {
  ifelse(t < 30, 0.05, ifelse(t <= 60, 0.05 - (t - 30) * (0.05 - 
    0.02)/30, 0.02))
}

infectious_hygiene_delayed_ramp_sim <- simulate(inf.prob.i = infectious_hygiene_delayed_ramp(1:366))

Experiment 3

Let’s repeat experiment 1, except this time instead of promoting hygiene measures in the symptomatic infected, we’ll promote, starting at day 15, prompt self-quarantine by anyone who is infected as soon as they become symptomatic. By “prompt”, we mean most such people will self-quarantine themselves immediately, but with an exponentially declining tail of such people taking longer to enter quarantine, with a few never complying. Those in self-quarantine won’t or can’t achieve complete social isolation, so we have set the act.rate parameter for the quarantined compartment to a quarter of that for the other compartments to simulate such a reduction in social mixing (an increase in social distancing) in that group.

quarantine_ramp <- function(t) {
  ifelse(t < 15, 0.0333, ifelse(t <= 30, 0.0333 + (t - 15) * 
    (0.3333 - 0.0333)/15, 0.333))
}

quarantine_ramp_sim <- simulate(quar.rate = quarantine_ramp(1:366))

Experiment 4

Let’s add a moderate increase in social distancing for everyone (halving the act.rate), again ramping it down between days 15 and 30.

social_distance_ramp <- function(t) {
  ifelse(t < 15, 10, ifelse(t <= 30, 10 - (t - 15) * (10 - 
    5)/15, 5))
}

soc_dist_ramp_sim <- simulate(act.rate.i = social_distance_ramp(1:366), 
  act.rate.e = social_distance_ramp(1:366))

Experiment 5

Let’s combine experiments 3 and 4: we’ll add a moderate increase in social distancing for everyone, as well as prompt self-quarantining in the symptomatic.

quar_soc_dist_ramp_sim <- simulate(quar.rate = quarantine_ramp(1:366), 
  act.rate.i = social_distance_ramp(1:366), act.rate.e = social_distance_ramp(1:366))

Now let’s examine the results.

Discussion

The results of our experiments almost speak for themselves, but a few things are worth highlighting:

Implementing interventions too late is almost worthless. Act early and decisively. You can always wind back the intervention later, whereas a failure to act early enough can never be recovered from.
Prompt self-quarantining of symptomatic cases is effective. In practice that means everyone with COVID-19-like symptoms, whether they actually have COVID-19 or something else, should immediately self-quarantine. Don’t wait to be tested.
A moderate increase in social distancing (decrease in social mixing) in everyone is also effective, mainly because it reduces exposure opportunities with both the asymptomatic-but-infected and the symptomatic infected.
Combining measures is even more effective, as can be seen in experiment 5. In fact, there are theoretical reasons to believe that the effect of combined measures is partially multiplicative, not just additive.
Public health interventions don’t just flatten the curve, they shrink it, and the result is very substantially reduced mortality due to COVID-19.

None of these insights are novel, but it is nice to be able to independently confirm the recommendations of various expert groups, such as the WHO Collaborating Centre for Infectious Disease Modelling at Imperial College London (ICL) who have recently released a report on the impact of non-pharmaceutical interventions (NPIs) to reduce COVID-19 mortality and healthcare demand which recommends similar strategies to those we have just discovered from our modest simulations in R.

Two more experiments

What happens if we dramatically increase social distancing through a two week lock-down, which is then relaxed? We’ll use a step function to model this. We test such a lock-down lasting from day 15 to 30, and separately a lock-down from day 30 to day 45 instead. We’ll model the lock-down by reducing the act.rate parameters for all compartments from 10 to 2.5.

twoweek_lockdown_day15_vector <- c(rep(10, 15), rep(2.5, 15), 
  rep(10, 336))
twoweek_lockdown_day30_vector <- c(rep(10, 30), rep(2.5, 15), 
  rep(10, 321))

twoweek_lockdown_day15_sim <- simulate(act.rate.i = twoweek_lockdown_day15_vector, 
  act.rate.e = twoweek_lockdown_day15_vector)

twoweek_lockdown_day30_sim <- simulate(act.rate.i = twoweek_lockdown_day30_vector, 
  act.rate.e = twoweek_lockdown_day30_vector)

Wow, that’s a bit surprising! The two week lock-down starting at day 15 isn’t effective at all - it just stops the spread in its tracks for two weeks, and then it just resumes again. But a two-week lock-down starting at day 30 is somewhat more effective, presumably because there are more infected people being taken out of circulation from day 30 onwards. But the epidemic still partially bounces back after the two weeks are over.

What this tells us is that single lock-downs for only two weeks aren’t effective. What about a lock-down for a whole month, instead, combined with prompt quarantine with even more effective isolation and hygiene measures for those quarantined?

fourweek_lockdown_day15_vector <- c(rep(10, 15), rep(2.5, 30), 
  rep(7.5, 321))
fourweek_lockdown_day30_vector <- c(rep(10, 30), rep(2.5, 30), 
  rep(7.5, 306))

fourweek_lockdown_day15_sim <- simulate(act.rate.i = fourweek_lockdown_day15_vector, 
  act.rate.e = fourweek_lockdown_day15_vector, quar.rate = quarantine_ramp(1:366), 
  inf.prob.q = 0.01)

fourweek_lockdown_day30_sim <- simulate(act.rate.i = fourweek_lockdown_day30_vector, 
  act.rate.e = fourweek_lockdown_day30_vector, quar.rate = quarantine_ramp(1:366), 
  inf.prob.q = 0.01)

Well, that’s satisfying! By acting early, and decisively, we’ve managed to stop COVID-19 dead in it tracks in experiment 8, and in doing so have saved many lives – at least, we have in our little simulated world. But even experiment 9 provides a much better outcome, indicating that decisive action, even if somewhat belated, is much better than none.

Of course, the real world is far more complex and messier, and COVID-19 may not behave in exactly the same way in real-life, but at least we can see the principles of public health interventions in action in our simulation, and perhaps better understand or want to question what is being done, or not done, or being done too late, to contain the spread of the virus in the real world.

Conclusion

Although there is still a lot of work yet to be done on the extensions to EpiModel demonstrated here, it seems that they offer promise as a tool for understanding real-world action and inaction on COVID-19, and prompting legitimate questions about such actions or lack thereof.

One would hope that governments are using far more sophisticated simulation models than the one we have described here, which was built over the course of just a few days, to plan or inform their responses to COVID-19. If not, they ought to be.

COVID-19 epidemiology with R

Thu, 05 Mar 2020 00:00:00 +0000

Tim Churches is a Senior Research Fellow at the UNSW Medicine South Western Sydney Clinical School at Liverpool Hospital, and a health data scientist at the Ingham Institute for Applied Medical Research, also located at Liverpool, Sydney. His background is in general medicine, general practice medicine, occupational health, public health practice, particularly population health surveillance, and clinical epidemiology.

Introduction

As I write this on 4th March, 2020, the world is on the cusp of a global COVID-19 pandemic caused by the SARS-Cov2 virus. Every news report is dominated by alarming, and ever-growing cumulative counts of global cases and deaths due to COVID-19. Dashboards of global spread are beginning to light up like Christmas trees.

For R users, an obvious question is: “Does R have anything to offer in helping to understand the situation?”.

The answer is: “Yes, a lot!”.

In fact, R is one of the tools of choice for outbreak epidemiologists, and a quick search will yield many R libraries on CRAN and elsewhere devoted to outbreak management and analysis. This post doesn’t seek to provide a review of the available packages – rather it illustrates the utility of a few of the excellent packages available in the R Epidemics Consortium (RECON) suite, as well as the use of base R and tidyverse packages for data acquisition, wrangling and visualization. This post is based on two much longer and more detailed blog posts I have published in the last few weeks on the same topic, but it uses US data.

Data acquisition

Obtaining detailed, accurate and current data for the COVID-19 epidemic is not as straightforward as it might seem. Various national and provincial/governmental web sites in affected countries provide detailed summary data on incident cases, recovered cases and deaths due to the virus, but these data tend to be in the form of counts embedded in (usually non-English) text.

There are several potential sources of data which have been abstracted and collated from such governmental sites. A widely-used source is a dataset which is being collated by Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) and which is used as the source for the dashboard mentioned above. It is very easy to use – just read CSV files from the appropriate GitHub URL. However, it lacks detail (that wasn’t its intended purpose) and contains quite a few missing or anomalous data points when examined as a differenced daily time-series of incident cases, a relatively minor issue that is explored further here.

Another set of convenient sources are relevant wikipedia pages, such as this one for China. There are equivalent pages for Japan, South Korea, Iran, Italy and many other countries. These wikipedia pages tend to be much more detailed and are well-referenced back to the original source web pages, but they are quite challenging to web-scrape because the format of the tables in which the data appears changes quite often, as various wikipedia contributors adjust their appearance. Nonetheless, we’ll scrape some detailed data about the initial set of identified COVID-19 cases in the United States (as at 4th March) from a suitable wikipedia page. The saving grace is that wikipedia pages are versioned, and thus it is possible to scrape data from a specific version of a table. But if you want daily updates to your data, using wikipedia pages as a source will involve daily maintenance of your web scraping code.

Incidence data collated by John Hopkins University

Acquiring these data is easy. The time-series format they provide is the most convenient for our purposes. We’ll also remove columns of US cases associated with the Diamond Princess cruise ship because we can assume that those cases were (home) quarantined on repatriation and were unlikely, or at least a lot less likely, to give rise to further cases. We also shift the dates in the JHU data back one day reflect US time zones, somewhat approximately, because the original dates are with respect to midnight UTC (Greenwich time). That is necessary because we will be combining the JHU data with wikipedia-sourced US data, which is tabulated by dates referencing local US time zones.

We also need to difference the JHU data, which is provided as cumulative counts, to get daily incident counts. Incident counts of cases are a lot more epidemiologically useful than cumulative counts. dplyr makes short work of all that.

jhu_url <- paste("https://raw.githubusercontent.com/CSSEGISandData/", 
  "COVID-19/master/csse_covid_19_data/", "csse_covid_19_time_series/", 
  "time_series_19-covid-Confirmed.csv", sep = "")

us_confirmed_long_jhu <- read_csv(jhu_url) %>% rename(province = "Province/State", 
  country_region = "Country/Region") %>% pivot_longer(-c(province, 
  country_region, Lat, Long), names_to = "Date", values_to = "cumulative_cases") %>% 
  # adjust JHU dates back one day to reflect US time, more or
# less
mutate(Date = mdy(Date) - days(1)) %>% filter(country_region == 
  "US") %>% arrange(province, Date) %>% group_by(province) %>% 
  mutate(incident_cases = c(0, diff(cumulative_cases))) %>% 
  ungroup() %>% select(-c(country_region, Lat, Long, cumulative_cases)) %>% 
  filter(str_detect(province, "Diamond Princess", negate = TRUE))

We can now visualize the JHU data using ggplot2, summarized for the whole of the US:

So, not a lot of data to work with as yet. One thing that is missing is information on whether those cases were imported, that is, the infection was most likely acquired outside the US, or whether they were local, as a result of local transmission (possibly from imported cases).

Scraping wikipedia

The wikipedia page on COVID-19 in the US contains several tables, one of which contains a line-listing of all the initial US cases, which at the time of writing appeared to be fairly complete up to 2nd March. We’ll scrape that line-listing table from this version of the wikipedia page, leveraging the excellent rvest package, part of the tidyverse. Once again we need to do a bit of data wrangling to get the parsed table into a usable form.

# the URL of the wikipedia page to use is in wp_page_url
wp_page_url

## [1] "https://en.wikipedia.org/w/index.php?title=2020_coronavirus_outbreak_in_the_United_States&oldid=944107102"

# read the page using the rvest package.
outbreak_webpage <- read_html(wp_page_url)

# parse the web page and extract the data from the eighth
# table
us_cases <- outbreak_webpage %>% html_nodes("table") %>% .[[8]] %>% 
  html_table(fill = TRUE)

# The automatically assigned column names are OK except that
# instead of County/city and State columns we have two
# columns called Location, due to the unfortunate use of
# colspans in the header row.  The tidyverse abhors
# duplicated column names, so we have to fix those, and make
# some of the other colnames a bit more tidyverse-friendly.
us_cases_colnames <- colnames(us_cases)
us_cases_colnames[min(which(us_cases_colnames == "Location"))] <- "CityCounty"
us_cases_colnames[min(which(us_cases_colnames == "Location"))] <- "State"
us_cases_colnames <- us_cases_colnames %>% str_replace("Location", 
  "CityCounty") %>% str_replace("Location", "State") %>% str_replace("Case no.", 
  "CaseNo") %>% str_replace("Date announced", "Date") %>% str_replace("CDC origin type", 
  "OriginTypeCDC") %>% str_replace("Treatment facility", "TreatmentFacility")
colnames(us_cases) <- us_cases_colnames

# utility function to remove wikipedia references in square
# brackets
rm_refs <- function(x) stringr::str_split(x, "\\[", simplify = TRUE)[, 
  1]

# now remove references from CaseNo column, convert it to
# integer, convert the date column to date type and then lose
# all rows which then have NA in CaseNo or NA in the date
# column
us_cases <- us_cases %>% mutate(CaseNo = rm_refs(CaseNo)) %>% 
  mutate(CaseNo = as.integer(CaseNo), Date = as.Date(parse_date_time(Date, 
    c("%B %d, %Y", "%d %B, %Y")))) %>% filter(!is.na(CaseNo), 
  !is.na(Date)) %>% # convert the various versions of unknown into NA in the
# OriginTypeCDC column
mutate(OriginTypeCDC = if_else(OriginTypeCDC %in% c("Unknown", 
  "Undisclosed"), NA_character_, OriginTypeCDC))

At this point we have an acceptably clean table, that looks like this:

US cases of COVID-19 as at 3rd March 2020

CaseNo	Date	Status	OriginTypeCDC	Origin	CityCounty	State	TreatmentFacility	Sex	Age
Last 6 rows
60	2020-03-04	Deceased	NA	Unknown	Placer County	California	Hospitalized	Male	Elderly adult
61	2020-03-04	Confirmed	NA	Unknown	Santa Clara County	California	Hospitalized	Male	Undisclosed
62	2020-03-04	Confirmed	Person-to-person spread	Undisclosed	Santa Clara County	California	In-home isolation	Male	Undisclosed
63	2020-03-04	Confirmed	Person-to-person spread	Undisclosed	Santa Clara County	California	In-home isolation	Male	Undisclosed
64	2020-03-04	Confirmed	NA	Unknown	Williamson County	Tennessee	In-home isolation	Male	44
65	2020-03-05	Confirmed	Travel-related	Unknown	Clark County	Nevada	VA Southern Nevada Healthcare System	Male	50's
66	2020-03-05	Confirmed	Travel-related	Unknown	Chicago	Illinois	Rush University Medical Center	Male	20's
First 6 rows
1	2020-01-21	Recovered	Travel-related	Wuhan, China	Snohomish County	Washington	Providence Regional Medical Center Everett	Male	35
2	2020-01-24	Recovered	Travel-related	Wuhan, China	Chicago	Illinois	St. Alexius Medical Center	Female	60s
3	2020-01-25	Recovered	Travel-related	Wuhan, China	Orange County	California	In-home isolation	Male	50s
4	2020-01-26	Confirmed	Travel-related	Wuhan, China	Los Angeles County	California	Undisclosed	Undisclosed	Undisclosed
5	2020-01-26	Recovered	Travel-related	Wuhan, China	Tempe	Arizona	In-home isolation	Male	Under 60
6	2020-01-30	Recovered	Person-to-person spread	Spouse	Chicago	Illinois	St. Alexius Medical Center	Male	60s
Source: wikipedia: 2020 coronavirus outbreak in the United States

We’ll won’t bother cleaning all the columns, because we’ll only be using a few of them here.

OK, so we’ll use the wikipedia data prior to 20th February, but the JHU counts after that, but we’ll use the wikipedia data after 20th February to divide the JHU counts into travel-related or not, more or less. That will give us a data set which distinguishes local from imported cases, at least to the extent of completeness of our data sources. Outbreak epidemiology involves practicing the art of good enough for now.

Let’s visualize each of our two sources, and the combined data set.

Analysis with the `earlyR` and `EpiEstim` packages

The earlyR package, as its name suggests, is intended for use early in an outbreak to calculate several key statistics. In particular the get_R() function in earlyR calculates a maximum-likelihood estimate for the reproduction number, which is the mean number of new cases each infected person give rise to. The overall_infectivity() function in the EpiEstim package calculates $\lambda$ (lambda), which is a relative measure of the current “force of infection” or infectivity of an outbreak:

\[ \lambda = \sum_{s=1}^{t-1} {y_{s} w (t - s)} \]

where $w()$ is the probability mass function (PMF) of the serial interval, and $y_s$ is the incidence at time $s$. If $\lambda$ is falling, then that’s good: if not, bad.

The critical parameter for these calculations is the distribution of serial intervals (SI), which is the time between the date of onset of symptoms for a case and the dates of onsets for any secondary cases that case gives rise to. Typically a discrete $\gamma$ distribution for these serial intervals is assumed, parameterised by a mean and standard deviation, although more complex distributions are probably more realistic. See the previous post for more detailed discussion of the serial interval, and the paramount importance of line-listing data from which it can be empirically estimated.

For now, we’ll just use a discrete $\gamma$ distribution with a mean of 5.0 days and a standard deviation of 3.4 for the serial interval distribution. That mean is less than estimates published earlier in the outbreak in China, but appears to be closer to the behavior of the COVID-19 virus (based on a personal communication from an informed source who is party to WHO conference calls on COVID-19). Obviously a sensitivity analysis, using different but plausible serial interval distributions, should be undertaken, but we’ll omit that here for the sake of brevity.

Note that only local transmission is used to calculate $\lambda$. If we just use the JHU data, which includes both local and imported cases, our estimates of $\lambda$ would be biased, upwards.

The US is not winning the war against COVID-19, but it is early days yet.

We can also estimate the reproduction number.

That estimate of $R_{0}$ is consistent with those reported recently by WHO, although higher than some initial estimates from Wuhan. The key thing is that it is well above 1.0, meaning that the outbreak is growing, rapidly.

Fitting a log-linear model to the epidemic curve

We can also use functions in the RECON incidence package to fit a log-linear model to our epidemic curve. Typically, two models are fitted, one for the growth-phase and one for the decay phase. Functions are provided in the package for finding the peak of the epidemic curve using naïve and optimizing methods. Examples of that can be found here.

But for now, the US outbreak is still in growth phase, so we only fit one curve.

us_incidence_fit <- incidence::fit(local_cases_obj, split = NULL)

# plot the incidence data and the model fit
plot(local_cases_obj) %>% add_incidence_fit(us_incidence_fit)

That’s clearly not a good fit, because we are including the handful of very early cases that did not appear to establish sustained chains of local transmission. Let’s exclude them.

That’s a much better fit!

From the that model, we can extract various (very preliminary at this early stage) parameters of interest: the growth rate is 0.54 (95% CI 0.32 - 0.77), which is equivalent to a doubling time of 1.3 days (95% CI 0.9 - 2.2 days).

That’s all a bit alarming, but these estimates are almost certainly biased because cases are being tabulated by their date of reporting, and not by their date of symptom onset. I discussed the extreme importance of health authorities reporting or providing data by date of onset in an earlier post. Nonetheless, as the the epidemic in the US spreads, the bias due to use of date of reporting should diminish, provided that testing and reporting of cases occurs swiftly and consistently. The ability to test and report cases promptly is a key indicator of the quality of public health intervention capability.

We can also project how many cases might be expected in the next week, assuming that public health controls don’t start to have an effect, and subject to the estimation biases discussed above, and bearing it mind our model is fitted to just a few days of data, so far. We’ll plot on a log scale so the observed cases so far aren’t obscured by the predicted values.

On a linear scale, that looks like this:

So, we predict, on very sketchy preliminary data, over 2211 new cases per day by 10 March. That’s probably an overestimate, due to potential reporting-date-not-onset-date bias already discussed, but it nevertheless illustrates the exponential nature of typical epidemic behavior.

Humans tend to use linear heuristics when contemplating trends, and thus tend to be surprised by such exponential behavior, and fail to plan for it accordingly.

Estimating the instantaneous effective reproduction ratio

One other statistic which the EpiEstim package estimates is the instantaneous effective reproduction number, based on an adjustable sliding window. This is very useful for assessing how well public health interventions are working. There isn’t enough US data available, yet, to estimate this, but here is an example of a plot of the instantaneous $R_{e}$ for Hubei province in China, taken from an earlier blog post:

You can clearly see the effect of the lock-down implemented in Hubei province and Wuhan city on or around 24th January, and the fact that the instantaneous $R_{e}$ started to fall a long time before the daily incidence of new cases reached its peak. Availability of such information helps governmental authorities to keep their nerve and to persist with unpopular public health measures, even in the face of rising incidence.

Conclusion

In this post we have seen how base R, the tidyverse packages, and libraries provided by R Epidemics Consortium (RECON) can be used to assemble COVID-19 outbreak data, visualize it, and estimate some key statistics from it which are vital for assessing and planning the public health response to this disease. There are several other libraries for R than can also be used for such purposes. It should only take a small team of data scientists a few days, using these and related tools, to construct ongoing reports or decision support tools, able to be updated continuously, or at least daily, to help support public health authorities in their (literally) life-and-death fight against COVID-19.

But you need to start right away: epidemic behavior is exponential.

Medicine on R Views

Multistate Models for Medical Applications

The Data

Setting Up and Running the Model

Survival Curves and Calculations

Hazard Ratios

Exploring Transition Probabilities and Intensities

Learning More About Multi-State Survival Models

The COVID19 package, an interface to the COVID-19 Data Hub

Why another package for COVID-19 data

What’s new in version 3.0.0

Data coverage

Data transparency

World Bank data

Mobility data

Spatial data

Academic publications

Cite as

Simulating COVID-19 interventions with R

DISCLAIMER

Introduction

The EpiModel package

Extensions to EpiModel

Baseline simulation

Running intervention experiments

More experiments

Experiment 2

Experiment 3

Experiment 4

Experiment 5

Discussion

Two more experiments

Conclusion

COVID-19 epidemiology with R

Introduction

Data acquisition

Incidence data collated by John Hopkins University

Scraping wikipedia

Analysis with the earlyR and EpiEstim packages

Fitting a log-linear model to the epidemic curve

Estimating the instantaneous effective reproduction ratio

Conclusion

The `EpiModel` package

Extensions to `EpiModel`

Analysis with the `earlyR` and `EpiEstim` packages