Estimate Infections, the Time-Varying Reproduction Number and the Rate of Growth

Uses a non-parametric approach to reconstruct cases by date of infection from reported cases. It uses either a generative Rt model or non-parametric back calculation to estimate underlying latent infections and then maps these infections to observed cases via uncertain reporting delays and a flexible observation model. See the examples and function arguments for the details of all options. The default settings may not be sufficient for your use case so the number of warmup samples (stan_args = list(warmup)) may need to be increased as may the overall number of samples. Follow the links provided by any warnings messages to diagnose issues with the MCMC fit. It is recommended to explore several of the Rt estimation approaches supported as not all of them may be suited to users own use cases. See here for an example of using estimate_infections within the epinow wrapper to estimate Rt for Covid-19 in a country from the ECDC data source.

Usage

estimate_infections(
  reported_cases,
  generation_time = generation_time_opts(),
  delays = delay_opts(),
  truncation = trunc_opts(),
  rt = rt_opts(),
  backcalc = backcalc_opts(),
  gp = gp_opts(),
  obs = obs_opts(),
  stan = stan_opts(),
  horizon = 7,
  CrIs = c(0.2, 0.5, 0.9),
  filter_leading_zeros = TRUE,
  zero_threshold = Inf,
  id = "estimate_infections",
  verbose = interactive()
)

Arguments

reported_cases: A data frame of confirmed cases (confirm) by date (date). confirm must be integer and date must be in date format.
generation_time: A call to generation_time_opts() defining the generation time distribution used. For backwards compatibility a list of summary parameters can also be passed.
delays: A call to delay_opts() defining delay distributions and options. See the documentation of delay_opts() and the examples below for details.
truncation: A list of options as generated by trunc_opts() defining the truncation of observed data. Defaults to trunc_opts(). See estimate_truncation() for an approach to estimating truncation from data.
rt: A list of options as generated by rt_opts() defining Rt estimation. Defaults to rt_opts(). Set to NULL to switch to using back calculation rather than generating infections using Rt.
backcalc: A list of options as generated by backcalc_opts() to define the back calculation. Defaults to backcalc_opts().
gp: A list of options as generated by gp_opts() to define the Gaussian process. Defaults to gp_opts().Set to NULL to disable the Gaussian process.
obs: A list of options as generated by obs_opts() defining the observation model. Defaults to obs_opts().
stan: A list of stan options as generated by stan_opts(). Defaults to stan_opts(). Can be used to override data, init, and verbose settings if desired.
horizon: Numeric, defaults to 7. Number of days into the future to forecast.
CrIs: Numeric vector of credible intervals to calculate.
filter_leading_zeros: Logical, defaults to TRUE. Should zeros at the start of the time series be filtered out.
zero_threshold: Numeric defaults to Inf. Indicates if detected zero cases are meaningful by using a threshold number of cases based on the 7 day average. If the average is above this threshold then the zero is replaced with the backwards looking rolling average. If set to infinity then no changes are made.
id: A character string used to assign logging information on error. Used by regional_epinow to assign errors to regions. Alter the default to run with error catching.
verbose: Logical, defaults to TRUE when used interactively and otherwise FALSE. Should verbose debug progress messages be printed. Corresponds to the "DEBUG" level from futile.logger. See setup_logging for more detailed logging options.

Value

A list of output including: posterior samples, summarised posterior samples, data used to fit the model, and the fit object itself.

Author

Sam Abbott

Examples

# \donttest{
# set number of cores to use
old_opts <- options()
options(mc.cores = ifelse(interactive(), 4, 1))

# get example case counts
reported_cases <- example_confirmed[1:60]

# set up example generation time
generation_time <- generation_time_opts(
  disease = "SARS-CoV-2", source = "ganyani", fixed = TRUE
)
# set delays between infection and case report
incubation_period <- get_incubation_period(
  disease = "SARS-CoV-2", source = "lauer"
)
reporting_delay <- list(
  mean = convert_to_logmean(2, 1), mean_sd = 0,
  sd = convert_to_logsd(2, 1), sd_sd = 0, max = 10
)

# default settings but assuming that delays are fixed rather than uncertain
def <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
  rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
  stan = stan_opts(control = list(adapt_delta = 0.95))
)
#> Warning: There were 9 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
# real time estimates
summary(def)
#>                                  measure               estimate
#> 1: New confirmed cases by infection date    2158 (1128 -- 4070)
#> 2:        Expected change in daily cases      Likely decreasing
#> 3:            Effective reproduction no.     0.86 (0.61 -- 1.2)
#> 4:                        Rate of growth -0.04 (-0.11 -- 0.041)
#> 5:          Doubling/halving time (days)       -18 (17 -- -6.1)
# summary plot
plot(def)


# decreasing the accuracy of the approximate Gaussian to speed up computation.
# These settings are an area of active research. See ?gp_opts for details.
agp <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
  rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
  gp = gp_opts(ls_min = 10, basis_prop = 0.1),
  stan = stan_opts(control = list(adapt_delta = 0.95))
)
#> Warning: There were 12 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
summary(agp)
#>                                  measure                estimate
#> 1: New confirmed cases by infection date     2289 (1217 -- 3968)
#> 2:        Expected change in daily cases       Likely decreasing
#> 3:            Effective reproduction no.      0.88 (0.63 -- 1.1)
#> 4:                        Rate of growth -0.033 (-0.11 -- 0.037)
#> 5:          Doubling/halving time (days)        -21 (19 -- -6.4)
plot(agp)


# Adjusting for future susceptible depletion
dep <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
  rt = rt_opts(
    prior = list(mean = 2, sd = 0.1),
    pop = 1000000, future = "latest"
  ),
  gp = gp_opts(ls_min = 10, basis_prop = 0.1), horizon = 21,
  stan = stan_opts(control = list(adapt_delta = 0.95))
)
#> Warning: There were 274 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
#> Warning: The largest R-hat is 1.36, indicating chains have not mixed.
#> Running the chains for more iterations may help. See
#> https://mc-stan.org/misc/warnings.html#r-hat
#> Warning: Bulk Effective Samples Size (ESS) is too low, indicating posterior means and medians may be unreliable.
#> Running the chains for more iterations may help. See
#> https://mc-stan.org/misc/warnings.html#bulk-ess
#> Warning: Tail Effective Samples Size (ESS) is too low, indicating posterior variances and tail quantiles may be unreliable.
#> Running the chains for more iterations may help. See
#> https://mc-stan.org/misc/warnings.html#tail-ess
plot(dep)


# Adjusting for truncation of the most recent data
# See estimate_truncation for an approach to estimating this from data
trunc_dist <- trunc_opts(dist = list(
  mean = convert_to_logmean(0.5, 0.5), mean_sd = 0.1,
  sd = convert_to_logsd(0.5, 0.5), sd_sd = 0.1,
  max = 3
))
trunc <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
  truncation = trunc_dist,
  rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
  gp = gp_opts(ls_min = 10, basis_prop = 0.1),
  stan = stan_opts(control = list(adapt_delta = 0.95))
)
#> Warning: There were 1725 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
#> Warning: The largest R-hat is 3.45, indicating chains have not mixed.
#> Running the chains for more iterations may help. See
#> https://mc-stan.org/misc/warnings.html#r-hat
#> Warning: Bulk Effective Samples Size (ESS) is too low, indicating posterior means and medians may be unreliable.
#> Running the chains for more iterations may help. See
#> https://mc-stan.org/misc/warnings.html#bulk-ess
#> Warning: Tail Effective Samples Size (ESS) is too low, indicating posterior variances and tail quantiles may be unreliable.
#> Running the chains for more iterations may help. See
#> https://mc-stan.org/misc/warnings.html#tail-ess
plot(trunc)


# using back calculation (combined here with under reporting)
# this model is in the order of 10 ~ 100 faster than the gaussian process
# method
# it is likely robust for retrospective Rt but less reliable for real time
# estimates
# the width of the prior window controls the reliance on observed data and
# can be optionally switched off using backcalc_opts(prior = "none"),
# see ?backcalc_opts for other options
backcalc <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
  rt = NULL, backcalc = backcalc_opts(),
  obs = obs_opts(scale = list(mean = 0.4, sd = 0.05)),
  horizon = 0
)
plot(backcalc)


# Rt projected into the future using the Gaussian process
project_rt <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
  rt = rt_opts(
    prior = list(mean = 2, sd = 0.1),
    future = "project"
  )
)
#> Warning: There were 7 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
plot(project_rt)


# default settings on a later snapshot of data
snapshot_cases <- example_confirmed[80:130]
snapshot <- estimate_infections(snapshot_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
  rt = rt_opts(prior = list(mean = 1, sd = 0.1))
)
#> Warning: There were 15 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
plot(snapshot)


# stationary Rt assumption (likely to provide biased real-time estimates)
# with uncertain reporting delays
stat <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay),
  rt = rt_opts(prior = list(mean = 2, sd = 0.1), gp_on = "R0")
)
plot(stat)


# no gaussian process (i.e fixed Rt assuming no breakpoints)
# with uncertain reporting delays
fixed <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay),
  gp = NULL
)
plot(fixed)


# no delays
no_delay <- estimate_infections(reported_cases, generation_time = generation_time)
#> Warning: There were 7 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
plot(no_delay)


# break point but otherwise static Rt
# with uncertain reporting delays
bp_cases <- data.table::copy(reported_cases)
bp_cases <- bp_cases[, breakpoint := ifelse(date == as.Date("2020-03-16"), 1, 0)]
bkp <- estimate_infections(bp_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay),
  rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
  gp = NULL
)
# break point effect
summary(bkp, type = "parameters", params = "breakpoints")
#>    date    variable strat type     median       mean         sd   lower_90
#> 1: <NA> breakpoints     1 <NA> -0.6575708 -0.6573689 0.02492359 -0.6981136
#>      lower_50  lower_20   upper_20   upper_50   upper_90
#> 1: -0.6744142 -0.664363 -0.6514147 -0.6405355 -0.6156105
plot(bkp)


# weekly random walk
# with uncertain reporting delays
rw <- estimate_infections(reported_cases,
  generation_time = generation_time,
  delays = delay_opts(incubation_period, reporting_delay),
  rt = rt_opts(prior = list(mean = 2, sd = 0.1), rw = 7),
  gp = NULL
)

# random walk effects
summary(rw, type = "parameters", params = "breakpoints")
#>    date    variable strat type      median        mean         sd   lower_90
#> 1: <NA> breakpoints     1 <NA> -0.12819536 -0.12940593 0.06529075 -0.2414176
#> 2: <NA> breakpoints     2 <NA> -0.14862209 -0.14857710 0.07807458 -0.2712666
#> 3: <NA> breakpoints     3 <NA> -0.21726019 -0.21684435 0.08481809 -0.3522205
#> 4: <NA> breakpoints     4 <NA> -0.28791802 -0.28938151 0.09334717 -0.4384869
#> 5: <NA> breakpoints     5 <NA> -0.06384264 -0.06330484 0.09558231 -0.2211241
#> 6: <NA> breakpoints     6 <NA>  0.04696035  0.04819642 0.09507366 -0.1043804
#> 7: <NA> breakpoints     7 <NA> -0.06281678 -0.06573170 0.10742266 -0.2441340
#> 8: <NA> breakpoints     8 <NA> -0.01544349 -0.02434233 0.17527619 -0.3356858
#>      lower_50    lower_20    upper_20     upper_50    upper_90
#> 1: -0.1723095 -0.14447766 -0.11206116 -0.085961728 -0.02339026
#> 2: -0.2002301 -0.16973490 -0.12790066 -0.097444818 -0.02029059
#> 3: -0.2705744 -0.23837064 -0.19817926 -0.163206542 -0.07124549
#> 4: -0.3511505 -0.31151381 -0.26633732 -0.228096025 -0.13323060
#> 5: -0.1260353 -0.08668274 -0.03870810 -0.001795995  0.09281004
#> 6: -0.0147378  0.02175665  0.06968854  0.110283011  0.20652710
#> 7: -0.1384181 -0.09085642 -0.03675255  0.007472943  0.10863517
#> 8: -0.1305505 -0.05722155  0.02920220  0.088678873  0.25263744
plot(rw)


options(old_opts)
# }