R/regionalJointFcsts.r

In w-hardy/serCymruTools: Tools For Analysing GP Prescribing Data

#' @title Forecasts for each regional unit
#'
#' @description Various fable forecasts for monthly quantity for each regional_unit. Can make use of plan() futures.
#'
#' @param data A dataframe with time as `datename` and quantity as `n`.
#' @param h The number of months that should forecast.
#'
#' @importFrom distributional variance
#' @import dplyr
#' @import fabletools
#' @import furrr
#' @import future
#' @importFrom stats median quantile
#' @import tsibble
#' @import urca
#'
#' @return Model forecasts
#' @export
#'
#' @examples
#' \dontrun{regionalJointFcsts(data)}
#'
regionalJointFcsts <- function(data, h ="8 months"){
  regions <- unique(data$regional_unit)

  fable_fcst <-
    future_map_dfr(.x = regions,
                   .f = ~fableModels(filter(data, regional_unit ==.x)) %>%
                     generate(h = h, times = 1000) %>%
                     as_tibble() %>%
                     group_by(regional_unit, datename, .model) %>%
                     summarise(dist = distributional::dist_sample(list(.sim))) %>%
                     ungroup() %>%
                     # as_fable(index = datename, key = .model, distribution = dist, response = "n") %>%
                     as_tibble(),
                   .options = furrr_options(seed = TRUE))
  message("fable forecasts complete")


  joint_fcst <-
    fable_fcst %>%
    dplyr::mutate(lb_95 = quantile(dist, .025),
                  lb_80 = quantile(dist, .1),
                  med = median(dist),
                  ub_80 = quantile(dist, .9),
                  ub_95 = quantile(dist, .975),
                  sd = distributional::variance(dist)^.5,
                  n = NULL # Remove distribution from returned object to reduce size
                  )

  return(joint_fcst)
}