In kmcconeghy/flumodelr: An R Package for Estimating Attributable Influenza Morbidity and Mortality

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
options(tibble.print_min = 4L, tibble.print_max = 4L)
library(flumodelr)
library(lubridate)
library(scales)
library(forecast)
library(imputeTS)

Imputation

Constructing the counterfactual of baseline influenza activity during an active influenza season can be put into the framework of missing data.

The influenza season time of yyyy-40 -> yyyy-23 can be set to missing, then using imputation methods you can fill in the missing timepoints using the off-season observations.

The ImputeTS package allows for a variety imputation approaches.

Influenza data

fludta <- flumodelr::fludta
fludta

Create missing dataset

fludta_miss <- if_else(fludta$epi, NA_integer_, fludta$fludeaths)

kalman

fludta_im <- na.kalman(fludta_miss, model='auto.arima')

mydate <- as_date(fludta$yrweek_dt)
fludta_plot <- cbind(date = mydate, 
                         fludta_miss,
                         fludta_im) %>% as.data.frame(.)

ggplot(data=fludta_plot, aes(x=date)) +
  geom_point(aes(y=fludta_miss)) +
  geom_line(aes(y=fludta_im))

`flugam` function

Using only off-season as baseline

fit <- fludta %>%
  bind_cols(., flugam(data=fludta, outc=fludeaths, time=week_in_order, season=epi))

#Set up graph labels, line specs
line_names <- c("Deaths From P&I", "Expected", "Baseline")
line_cols <- c("#CC0000", "black", "black")
line_types <- c(1, 1, 2)
names(line_cols) <- line_names
names(line_types) <- line_names

ggplot(fit, aes(x=yrweek_dt)) + 
  geom_line(aes(y=fludeaths, colour=line_names[[1]], 
                linetype=line_names[[1]]), size=0.8) +
  geom_line(aes(y=flu_pred, colour=line_names[[2]], 
                linetype=line_names[[2]]), size=0.8) +
  geom_line(aes(y=flu_base_upr, colour=line_names[[3]], 
                linetype=line_names[[3]]), size=0.8) +
  scale_colour_manual("Line", breaks=line_names, values = line_cols) +
  scale_linetype_manual("Line",  breaks=line_names, values = line_types) +
  scale_x_date(labels = date_format("%Y"), date_breaks="1 year",
               expand=c(0, .9)) + 
  xlab("Year") + 
  ylab("% of Deaths from P&I") + 
  theme_light(base_size=14) +
  theme(legend.text=element_text(size=10), 
        plot.title = element_text(size=14)) +
  labs(title="Figure 1. Pneumonia and Influenza Mortality",
       caption="Generalized additive model - Seasonal only") +
  guides(colour = guide_legend("Line"), linetype = guide_legend("Line"))

Using viral data as baseline

fit <- fludta %>%
  bind_cols(., flugam(data=fludta, outc=fludeaths, 
                      time=week_in_order, viral='prop_flupos'))

#Set up graph labels, line specs
line_names <- c("Deaths From P&I", "Expected", "Baseline")
line_cols <- c("#CC0000", "black", "black")
line_types <- c(1, 1, 2)
names(line_cols) <- line_names
names(line_types) <- line_names

ggplot(fit, aes(x=yrweek_dt)) + 
  geom_line(aes(y=fludeaths, colour=line_names[[1]], 
                linetype=line_names[[1]]), size=0.8) +
  geom_line(aes(y=flu_pred, colour=line_names[[2]], 
                linetype=line_names[[2]]), size=0.8) +
  geom_line(aes(y=flu_base_upr, colour=line_names[[3]], 
                linetype=line_names[[3]]), size=0.8) +
  scale_colour_manual("Line", breaks=line_names, values = line_cols) +
  scale_linetype_manual("Line",  breaks=line_names, values = line_types) +
  scale_x_date(labels = date_format("%Y"), date_breaks="1 year",
               expand=c(0, .9)) + 
  xlab("Year") + 
  ylab("% of Deaths from P&I") + 
  theme_light(base_size=14) +
  theme(legend.text=element_text(size=10), 
        plot.title = element_text(size=14)) +
  labs(title="Figure 2. Pneumonia and Influenza Mortality",
       caption="Generalized additive model - Viral added") +
  guides(colour = guide_legend("Line"), linetype = guide_legend("Line"))