library(dplyr)
library(pander)
library(fluEvidenceSynthesis)

Introduction

This package implements all the tools needed to analyse and compare the effectiveness of different Influenza vaccine programs (see Baguelin et al. (2013) for more details). This analysis has two main steps.

. Parameter inference using existing model

. Simulation of different possible vaccination strategies using the inferred parameters

This vignette will focus on how the fluEvidenceSythesis package can be used to perform the second step. For details on the first step see the inference vignette.

To test the efficacy of different vaccination scenarios you first need to specify a vaccination scenario. A vaccination scenario specifies the rate of vaccination per day of each age group and risk group during a given period and the efficacy of the vaccine during that season. The epidemiological model can then be run with this scenario. To run the model we also need to have the epidemiological parameters that we inferred by fitting the model to our Influenza data (see inference vignette).

Building a vaccination scenario

data(coverage)
pander(head(coverage), caption = "The vaccination coverage rates in the UK in season 2007-08. Note that this only shows the first 6 weeks of data")

The as_vaccination_calendar() function can be used to build a vaccination scenario object based on coverage data. In the example below we use the coverage rates for the 2007-08 season in the UK. If there are multiple age groups and risk groups then the layout in general is expected to be all age groups for one risk group, followed by the age groups for the second risk group etc. In the example below the efficacy of the under 65 at low risk is expected to be $.7$ and for the 65+ the efficacy is $.4$.

library("fluEvidenceSynthesis")
data(coverage)
# Coverage rates for respectively low risk <65, low risk 65+,
# high risk <65 and 65+. Original is in percentages. Here converted to fraction
cov <- coverage[,c("Under.65","X65","at.risk.under.65","X65")]/100.0

vaccine_calendar <- as_vaccination_calendar(efficacy = c(0.7, 0.4, 0.7, 0.4), 
                                        dates = coverage$Date,
                                        coverage = cov, 
                                        no_age_groups = 2, no_risk_groups = 2)

More age groups

Below we show how to create a vaccination calendar for 7 age groups and 3 risk groups. We assume at risk young children and 65 year and older get a vaccine.

library("fluEvidenceSynthesis")

efficacy <- rep(c(0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.3), 3)
coverage <- matrix(rep(0,21*4),ncol = 21)
dates <-  c(as.Date("2010-10-01"), as.Date("2010-11-01"),
            as.Date("2010-12-01"), as.Date("2011-01-01"))


# Set rate of vaccine uptake for different dates/age groups
# In this case the elderly (age group 7) start with a coverage of 0.62 in the first month
# followed by 0.7 and 0.925 in the second and third month. After three months the total uptake will be.
coverage[1,c(7,14,21)] <- 0.0
coverage[2,c(7,14,21)] <- 0.62
coverage[3,c(7,14,21)] <- 0.77
coverage[4,c(7,14,21)] <- 0.925

# Set coverage for high risk young children
coverage[1,c(8,9)] <- 0.0
coverage[2,c(8,9)] <- 0.62
coverage[3,c(8,9)] <- 0.62
coverage[4,c(8,9)] <- 0.62

vaccine_calendar <- as_vaccination_calendar(efficacy = efficacy, dates = dates, 
                                            coverage = coverage, no_age_groups = 7,
                                            no_risk_groups = 3)

Outbreak size

# Load needed data
data("demography")
data("polymod_uk")
data("inference.results")

# This returns the total size of the outbreak given the vaccination scenario and the
# 1000th posterior (mcmc) sample. The outbreak sizes is separated by age group and 
# risk groups
cases.per.year <- vaccination_scenario(demography = demography,
                     vaccine_calendar = vaccine_calendar,
                     polymod_data = as.matrix(polymod_uk),
                     contact_ids = inference.results$contact.ids[1000,],
                     parameters = inference.results$batch[1000,],
                     verbose = F
                    )

The above shows how to use a specific posterior (mcmc) sample to create one prediction. In general, you should have a number of samples from the posterior and you call vaccinationScenario using each of those samples. This will result in a posterior distribution for the predicted efficacy of your vaccinationScenario. This can then be used for further analysis, such as the cost effectiveness of your analysis.

Full posterior of cases

To get the full posterior of cases under this vaccination scenario you can run it for each inference sample as follows:

library(ggplot2)
cases <- rowSums(vaccination_scenario(demography=demography,
                              vaccine_calendar=vaccine_calendar,
                              polymod_data=as.matrix(polymod_uk),
                              contact_ids=inference.results$contact.ids,
                              parameters=inference.results$batch,
                              verbose = F
))
cases_df <- data.frame(value = cases, scenario = "Original")
ggplot(data = cases_df) + geom_histogram(aes(x = value), bins = 25)

Change the vaccination coverage

Here we show an example on how you could change the uptake rate of vaccination to a 80% uptake in all the age/risk groups.

# Helper function to scale the uptake of each age/risk group, so that at the end of the vaccination period the vaccination is equal to 
# the given final_uptake
change_coverage <- function(data, final_uptake) {
  sums <- data[nrow(data),]
  # If final uptake is zero in a group then we need to make some kind of assumption on uptake rate over time
  if (any(sums == 0)) {
    warning("No prior information on uptake rate. Using constant uptake rate")
    col <- which(sums == 0)
    data[,col] <- seq(0, (nrow(data)-1))
    sums <- data[nrow(data),]    
  }
  for(i in 1:nrow(data)) {
    data[i,] <- data[i,]*final_uptake/sums
  }
  data
}

# Scale all age groups to 80%
new_coverage <- change_coverage(coverage, rep(0.8, ncol(coverage)))

# The rest of the simulation is similar as above, but now using the new_calendar
new_vaccine_calendar <- as_vaccination_calendar(efficacy = efficacy, dates = dates, 
                                            coverage = new_coverage, no_age_groups = 7,
                                            no_risk_groups = 3)

new_cases <- 
  rowSums(vaccination_scenario(demography = demography,
                               vaccine_calendar = new_vaccine_calendar,
                               polymod_data = as.matrix(polymod_uk),
                               contact_ids = inference.results$contact.ids,
                               parameters = inference.results$batch,
                               verbose = F
  ))

# Add the new results to the cases_df table
cases_df <- data.frame(value = new_cases, scenario = "New") %>%
  rbind(cases_df)

ggplot(data=cases_df) + geom_violin(aes(y=value, x=scenario), scale = "width")

Possible exercises

  1. Try different vaccination scenarios
    • Uptake rate
    • Additional age groups/risk groups
  2. Explore the results by age group/risk group

References

Baguelin, Marc, Stefan Flasche, Anton Camacho, Nikolaos Demiris, Elizabeth Miller, and W. John Edmunds. ‘Assessing Optimal Target Populations for Influenza Vaccination Programmes: An Evidence Synthesis and Modelling Study.’ PLoS Med 10, no. 10 (2013): e1001527. doi:10.1371/journal.pmed.1001527.



MJomaba/flu-evidence-synthesis documentation built on April 26, 2022, 11:12 p.m.