plot_posterior_rt: Plot the estimated effective reproduction number trajectory

In bernadette-eu/Bernadette: Bayesian Inference and Model Selection for Stochastic Epidemics

Plot the estimated effective reproduction number trajectory

Description

Plot the estimated effective reproduction number trajectory

Usage

plot_posterior_rt(object, xlab = NULL, ylab = NULL, ...)

Arguments

object	A data frame from posterior_rt.
xlab	character; Title of x-axis.
ylab	character; Title of y-axis.
...	Optional arguments passed to scale_x_date and theme.

Value

A ggplot object which can be further customised using the ggplot2 package.

See Also

posterior_rt.

Examples

# Age-specific mortality/incidence count time series:
data(age_specific_mortality_counts)
data(age_specific_cusum_infection_counts)

# Import the age distribution for Greece in 2020:
age_distr <- age_distribution(country = "Greece", year = 2020)

# Lookup table:
lookup_table <- data.frame(Initial = age_distr$AgeGrp,
                          Mapping = c(rep("0-39",  8),
                                      rep("40-64", 5),
                                      rep("65+"  , 3)))

# Aggregate the age distribution table:
aggr_age <- aggregate_age_distribution(age_distr, lookup_table)

# Import the projected contact matrix for Greece:
conmat <- contact_matrix(country = "GRC")

# Aggregate the contact matrix:
aggr_cm <- aggregate_contact_matrix(conmat, lookup_table, aggr_age)

# Aggregate the IFR:
ifr_mapping <- c(rep("0-39", 8), rep("40-64", 5), rep("65+", 3))

aggr_age_ifr <- aggregate_ifr_react(age_distr, ifr_mapping, age_specific_cusum_infection_counts)

# Infection-to-death distribution:
ditd <- itd_distribution(ts_length  = nrow(age_specific_mortality_counts),
                         gamma_mean = 24.19231,
                         gamma_cv   = 0.3987261)

# Posterior sampling:

rstan::rstan_options(auto_write = TRUE)
chains <- 1
options(mc.cores = chains)

igbm_fit <- stan_igbm(y_data                      = age_specific_mortality_counts,
                      contact_matrix              = aggr_cm,
                      age_distribution_population = aggr_age,
                      age_specific_ifr            = aggr_age_ifr[[3]],
                      itd_distr                   = ditd,
                      incubation_period           = 3,
                      infectious_period           = 4,
                      likelihood_variance_type    = "linear",
                      ecr_changes                 = 7,
                      prior_scale_x0              = 1,
                      prior_scale_x1              = 1,
                      prior_scale_contactmatrix   = 0.05,
                      pi_perc                     = 0.1,
                      prior_volatility            = normal(location = 0, scale = 1),
                      prior_nb_dispersion         = exponential(rate = 1/5),
                      algorithm_inference         = "sampling",
                      nBurn                       = 10,
                      nPost                       = 30,
                      nThin                       = 1,
                      chains                      = chains,
                      adapt_delta                 = 0.6,
                      max_treedepth               = 14,
                      seed                        = 1)

post_rt_summary <- posterior_rt(object                      = igbm_fit,
                                y_data                      = age_specific_mortality_counts,
                                age_distribution_population = aggr_age,
                                infectious_period            = 4)

# Visualise the posterior distribution of the effective reproduction number:
plot_posterior_rt(post_rt_summary)

bernadette-eu/Bernadette documentation built on July 1, 2024, 9:58 p.m.