---
title: "Summary report of short-term forecasts for viral respiratory diseases by `ViroReportR`"
output: html_document
editor_options: 
  chunk_output_type: console
params:
  filepath: NULL
  start_date: NULL
  n_days: 7
  smooth: FALSE
  validate_window_size: 7
  disease_season: NULL
---


```{r setup, include=FALSE, echo = FALSE,  message = FALSE, warning = FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
# setup -------------------------------------------------------------------
library(dplyr)
library(ViroReportR)
library(ggplot2)
library(purrr)
library(kableExtra)
```


```{r load data}
# Load data
vri_data <- utils::read.csv(file.path(params$filepath))

vri_data$date <- lubridate::ymd(vri_data$date)

# VRI data set-up
vri_name_list <- vri_data %>% 
    dplyr::group_by(disease_type) %>% 
  dplyr::group_keys() %>% pull()


vri_data_list <- vri_data %>% 
  dplyr::group_by(disease_type) %>% 
  dplyr::group_map(~.x)

names(vri_data_list) <- vri_name_list

# document parameters set-up
start_date <- params$start_date
if(is.null(start_date)){
  start_date <- min(vri_data$date) + 13
}

forecast_horizon <- params$n_days
smooth <- params$smooth
validate_window_size <- params$validate_window_size
```



```{r generate forecasts}
forecasts_results <- tibble(
  vri_data_list,
  forecasts = map2(
    vri_data_list,
    vri_name_list,
    ~ generate_forecast(
      data = .x,
      smooth_data = smooth,
      type = .y,
      n_days = forecast_horizon,
      start_date = start_date
    )
  )
)

names(forecasts_results$forecasts) <- vri_name_list
names(forecasts_results$vri_data_list) <- vri_name_list
```

## Description

This report provides the forecast of `r forecast_horizon`-days ahead positive tests for the 3 prevalent respiratory viral tests in BC (Flu-A, RSV and SARS-CoV-2). Forecast reports were generated using the VRI data, the tests presents data on samples tested for different respiratory viruses. `vriforecasting` uses `EpiEstim` as the backend to forecast daily positive tests, which forecasts positive tests by estimating the instantaneous reproduction number using the [Cori method](https://academic.oup.com/aje/article/178/9/1505/89262) and then simulating the number of new positive tests using fixed exponential growth over a given time period. This is a short term prediction model, meaning that an increase in the time-period horizon over an optimal horizon of 1 or 2-weeks ahead results in a decline of prediction performance. The report is divided into two sections: `r forecast_horizon`-days forecast for the current season of respiratory positive tests as well as validation plots and metrics for the performance of the forecasting model on historical data to help in the assessment of model performance. 

# `r forecast_horizon`-days ahead forecast {.tabset}

### Description {.tabset}

This section presents the `r forecast_horizon`-days ahead forecasts for each virus. The forecasts include:

- Median predicted positive tests (p50)
- Prediction intervals (50% and 95%)
- The last estimated Rₜ value with 95% confidence intervals

Plots show the predicted positive tests alongside historical observations, helping visualize the expected trajectory of positive tests over the short-term forecast horizon.

```{r forecast plots and info, results = "asis", out.width = '80%'}
for (vri in vri_name_list) {
  cat(glue::glue("#### {vri} "))
  cat("\n\n\n")
 
  forecast_plot <- ggplot() +
  geom_ribbon(
    data = forecasts_results$forecasts[[vri]][["forecast_res_quantiles"]],
    aes(x = date, ymin = p10, ymax = p90, fill = "Prediction Interval"),
    alpha = 0.4
  ) +
  geom_line(
    data = forecasts_results$forecasts[[vri]][["forecast_res_quantiles"]],
    aes(x = date, y = p50, color = "Median Forecast"),
    linewidth = 1
  ) +
  geom_point(
    data = forecasts_results$vri_data_list[[vri]],
    aes(x = date, y = confirm, shape = "Positive Tests"),
    size = 2,
    color = "black"
  )  +
  
  labs(
    title = paste0(forecast_horizon, "-Day Forecast of Daily ", vri, " Positive Tests"),
    x = "Date", y = "Predicted Tests",
    fill = "", color = "", shape = ""
  ) +
  scale_fill_manual(values = c("Prediction Interval" = "skyblue")) +
  scale_color_manual(values = c("Median Forecast" = "blue")) +
  scale_shape_manual(values = c("Positive Tests" = 16)) +
  theme_minimal() +
  theme(legend.position = "top", legend.direction = "horizontal")
  
  # create Rt plot
  rt_plot <- ViroReportR:::plot_rt(forecasts_results$forecasts[[vri]])
  disease_season <- params$disease_season
  if (!is.null(disease_season) && !is.null(disease_season[[vri]])) {
    season_start <- as.Date(disease_season[[vri]][1])
    season_end   <- as.Date(disease_season[[vri]][2])
    
    forecast_plot <- forecast_plot +
      # season markers
      geom_vline(
        xintercept = season_start,
        color = "grey",
        linetype = "dashed",
        linewidth = 0.8
      ) +
      geom_vline(
        xintercept = season_end,
        color = "grey",
        linetype = "dashed",
        linewidth = 0.8
      ) +
      
      # labels for season lines
      annotate(
        "text",
        x = season_start,
        y = max(forecasts_results$vri_data_list[[vri]]$confirm, na.rm = TRUE),
        label = "Season Start",
        hjust = -0.1,
        vjust = -0.5,
        color = "grey",
        size = 3
      ) +
      annotate(
        "text",
        x = season_end,
        y = max(forecasts_results$vri_data_list[[vri]]$confirm, na.rm = TRUE),
        label = "Season End",
        hjust = -0.1,
        vjust = -0.5,
        color = "grey",
        size = 3
      )
    
    y_max <- max(ggplot2::layer_data(rt_plot)$ymax, na.rm = TRUE)
    
    
    rt_plot <- rt_plot +
      # season markers
      geom_vline(
        xintercept = season_start,
        color = "grey",
        linetype = "dashed",
        linewidth = 0.8
      ) +
      geom_vline(
        xintercept = season_end,
        color = "grey",
        linetype = "dashed",
        linewidth = 0.8
      ) +
      
      # labels for season lines
      annotate(
        "text",
        x = season_start,
        y = y_max,
        label = "Season Start",
        hjust = -0.1,
        vjust = -0.5,
        color = "grey",
        size = 3
      ) +
      annotate(
        "text",
        x = season_end,
        y = y_max,
        label = "Season End",
        hjust = -0.1,
        vjust = -0.5,
        color = "grey",
        size = 3
      )
  }
   
  print(forecast_plot)
  cat("\n\n\n")
  print(rt_plot)
  cat("\n\n\n")
  ViroReportR:::current_forecast_text(forecasts_results$forecasts[[vri]])
  cat("\n\n\n")
}
```


# `r forecast_horizon`-days ahead Model Forecast Validation

### Description {.tabset}

The forecasting model is trained on historical data and used to predict daily positive tests `r forecast_horizon`-days ahead. Validation compares the model's forecasted values with observed historical data. Overlap between the prediction intervals and actual positive tests indicates good model performance.

```{r forecast validation plots, results = "asis", out.width = '90%'}
# Filter out validation that occurs outside of season
if(!is.null(disease_season)){
  for (vri in names(vri_data_list)) {
  
  if (is.null(disease_season[[vri]])) next
  
  season_dates <- as.Date(disease_season[[vri]])
  season_start <- season_dates[1]
  season_end   <- season_dates[2]
  
  df <- vri_data_list[[vri]]
  
  # Ensure date is Date (only once)
  if (!inherits(df$date, "Date")) df$date <- as.Date(df$date)
  
  # includes 14 days before season start
  # since forecast starting on the 14th day
  lower_bound <- max(min(df$date, na.rm = TRUE), season_start - 14)
  upper_bound <- season_end
  
  vri_data_list[[vri]] <- df %>%
    dplyr::filter(date >= lower_bound, date <= upper_bound)
  }
}


validation_results <- tibble(
  vri_data_list,
  validation = map2(
    vri_data_list,
    vri_name_list,
    ~ generate_validation(
      data = .x,
      type = .y,
      n_days = forecast_horizon,
      start_date = min(.x$date, na.rm = TRUE),
      validate_window_size = params$validate_window_size,
      window_size = 7,
      smooth_data = smooth,
      smoothing_cutoff = 10
    )
  )
)
names(validation_results$validation) <- vri_name_list
names(validation_results$vri_data_list) <- vri_name_list

for (vri in vri_name_list) {
  cat("\n\n\n")
  cat(glue::glue("#### {vri}"))
  cat("\n\n\n")
  p <- plot_validation(data = vri_data_list[[vri]], validation_results$validation[[vri]], pred_plot = "ribbon")
  legend <- cowplot::get_legend(forecast_plot)
  print(cowplot::plot_grid(legend, p, ncol = 1, rel_heights = c(0.1, 1)))
}
```

# Forecast Validation Metrics

### Description {.tabset}

This section summarizes the predictive performance of the forecasting model using quantitative metrics:

- SMAPE (Symmetric Mean Absolute Percentage Error): Measures forecast accuracy while handling zero values in observed data. Lower values indicate better predictions.

- MASE (Mean Absolute Scaled Error): Scales forecast errors relative to the average absolute change in historical observations. Values closer to 1 indicate performance similar to a naïve forecast; values <1 indicate better predictive performance.

For each virus, the metrics table reports:

- The training period used for model fitting
- The forecast period being evaluated
- SMAPE and MASE values

Higher SMAPE or MASE values suggest poorer historical forecast performance, which may indicate potential limitations in current short-term forecasts.

```{r forecast validation metrics, results = "asis"}
for (vri in vri_name_list) {
  cat(glue::glue("#### {vri}"))
  cat("\n\n\n")
  table_html <- generate_validation_metric(
    data = vri_data_list[[vri]],
    validation_res = validation_results$validation[[vri]]
    ) %>%
  as.data.frame() %>%
  knitr::kable(escape = FALSE, booktabs = TRUE) %>%
  kableExtra::kable_styling(full_width = FALSE) %>%
  as.character()
  
  cat(table_html, "\n\n")
}
```

