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.

1. Parameter inference using existing model
2. 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

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)

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)

# 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
                    )

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)

# 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)))

## Warning in change_coverage(coverage, rep(0.8, ncol(coverage))): No prior
## information on uptake rate. Using constant uptake rate

# 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")

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.