From abaff9933562be8742e75941925555aa1c37ca77 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Wed, 20 May 2020 11:09:38 +0200 Subject: [PATCH 1/9] added forecast model wrapper --- R/model-wrappers.R | 65 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index 41726e3..92a689e 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -290,3 +290,68 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, return(sample_from_model) } + + + + +#' forecast model wrapper +#' +#' Allows users to forecast using models from the `forecast` +#' Note that `forecast` must be installed for this model wrapper to be functional. +#' @param model A `forecast` model object. +#' @inheritParams bsts_model +#' @export +#' @return A dataframe of predictions (with columns representing the +#' time horizon and rows representing samples). +#' +#' @importFrom stats ts +#' @importFrom purrr map +#' @importFrom dplyr bind_rows +#' +#' @examples \dontrun{ +#' +#' ## Used on its own +#' forecast_model(y = EpiSoon::example_obs_rts[1:10, ]$rt, +#' model = forecast::auto.arima, +#' samples = 10, horizon = 7) +#' +#' +#' forecast_rt(EpiSoon::example_obs_rts[1:10, ], +#' model = function(...){ +#' forecast_model(model = forecast::ets, ...)}, +#' horizon = 7, samples = 10) +#'} +#' + +forecast_model <- function(y = NULL, samples = NULL, + horizon = NULL, model = NULL) { + + check_suggests("forecast") + + # convert to timeseries object + timeseries <- stats::ts(y) + + # fit and forecast + fit <- model(timeseries) + prediction <- forecast::forecast(fit, h = horizon) + + ## Extract samples and tidy format + sample_from_model <- prediction + + if (samples == 1) { + sample_from_model <- data.frame(t(as.data.frame(sample_from_model$mean))) + rownames(sample_from_model) <- NULL + }else{ + mean <- as.numeric(prediction$mean) + upper <- prediction$upper[, ncol(prediction$upper)] + lower <- prediction$lower[, ncol(prediction$lower)] + sd <- (upper - lower) / 3.92 + sample_from_model <- purrr::map2(mean, sd, + ~ rnorm(samples, mean = .x, sd = .y)) + + sample_from_model <- dplyr::bind_cols(sample_from_model) + } + + return(sample_from_model) +} + From a40c2184b87f03dec3d4bb7a9fa1f89efdfd4b82 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Wed, 20 May 2020 11:26:56 +0200 Subject: [PATCH 2/9] namespace and roxygen manual updated --- NAMESPACE | 2 ++ R/model-wrappers.R | 2 +- man/forecast_model.Rd | 41 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 man/forecast_model.Rd diff --git a/NAMESPACE b/NAMESPACE index 2324183..3b616a3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(evaluate_model) export(fable_model) export(forecastHybrid_model) export(forecast_cases) +export(forecast_model) export(forecast_rt) export(iterative_case_forecast) export(iterative_rt_forecast) @@ -73,6 +74,7 @@ importFrom(stats,rpois) importFrom(stats,rt) importFrom(stats,sd) importFrom(stats,setNames) +importFrom(stats,ts) importFrom(tibble,tibble) importFrom(tidyr,expand_grid) importFrom(tidyr,gather) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index 92a689e..b5666eb 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -324,7 +324,7 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, #' forecast_model <- function(y = NULL, samples = NULL, - horizon = NULL, model = NULL) { + horizon = NULL, model = NULL) { check_suggests("forecast") diff --git a/man/forecast_model.Rd b/man/forecast_model.Rd new file mode 100644 index 0000000..670528b --- /dev/null +++ b/man/forecast_model.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model-wrappers.R +\name{forecast_model} +\alias{forecast_model} +\title{forecast model wrapper} +\usage{ +forecast_model(y = NULL, samples = NULL, horizon = NULL, model = NULL) +} +\arguments{ +\item{y}{Numeric vector of time points to forecast} + +\item{samples}{Numeric, number of samples to take.} + +\item{horizon}{Numeric, the time horizon over which to predict.} + +\item{model}{A \code{forecast} model object.} +} +\value{ +A dataframe of predictions (with columns representing the +time horizon and rows representing samples). +} +\description{ +Allows users to forecast using models from the \code{forecast} +Note that \code{forecast} must be installed for this model wrapper to be functional. +} +\examples{ +\dontrun{ + +## Used on its own +forecast_model(y = EpiSoon::example_obs_rts[1:10, ]$rt, + model = forecast::auto.arima, + samples = 10, horizon = 7) + + +forecast_rt(EpiSoon::example_obs_rts[1:10, ], + model = function(...){ + forecast_model(model = forecast::ets, ...)}, + horizon = 7, samples = 10) +} + +} From 4ce6c0adc1cec4c0ae8f568a9ada38193156ffcf Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Wed, 20 May 2020 16:43:33 +0200 Subject: [PATCH 3/9] updated documentation --- R/model-wrappers.R | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index b5666eb..ba67c98 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -201,7 +201,7 @@ fable_model <- function(y = NULL, samples = NULL, return(samples) } -#' forecastHybrid model wrapper +#' ForecastHybrid model wrapper #' #' Allows users to forecast using ensembles from the `forecastHybrid` package. Note that #' whilst weighted ensembles can be created this is not advised when samples > 1 as currently @@ -294,9 +294,9 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, -#' forecast model wrapper +#' Forecast model wrapper #' -#' Allows users to forecast using models from the `forecast` +#' Allows users to forecast using models from the `forecast` package. #' Note that `forecast` must be installed for this model wrapper to be functional. #' @param model A `forecast` model object. #' @inheritParams bsts_model @@ -320,6 +320,22 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, #' model = function(...){ #' forecast_model(model = forecast::ets, ...)}, #' horizon = 7, samples = 10) +#' +#' +#' +#' models <- list("ARIMA" = function(...) {forecast_model(model = forecast::auto.arima, ...)}, +#' "ETS" = function(...) {forecast_model(model = forecast::ets, ...)}, +#' "TBATS" = function(...) {forecast_model(model = forecast::tbats, ...)}) +#' +#' ## Compare models +#' evaluations <- compare_models(EpiSoon::example_obs_rts, +#' EpiSoon::example_obs_cases, models, +#' horizon = 7, samples = 10, +#' serial_interval = example_serial_interval) +#' +#' plot_forecast_evaluation(evaluations$forecast_rts, +#' EpiSoon::example_obs_rts, +#' horizon_to_plot = 7) #'} #' From 6116e8e3e7b4c94aa833d219b1a65ff67516cf12 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Wed, 20 May 2020 16:45:59 +0200 Subject: [PATCH 4/9] corrected example plot --- R/model-wrappers.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index ba67c98..4b660b8 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -335,7 +335,9 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, #' #' plot_forecast_evaluation(evaluations$forecast_rts, #' EpiSoon::example_obs_rts, -#' horizon_to_plot = 7) +#' horizon_to_plot = 7) + +#' ggplot2::facet_grid(~ model) + +#' cowplot::panel_border() #'} #' From 71f9140ea987ab6178941a812faf64e6e219c26d Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Wed, 20 May 2020 16:53:03 +0200 Subject: [PATCH 5/9] added possibility to pass arguments down to forecast_model() --- R/model-wrappers.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index 4b660b8..270daf2 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -342,7 +342,8 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, #' forecast_model <- function(y = NULL, samples = NULL, - horizon = NULL, model = NULL) { + horizon = NULL, model = NULL, + ...) { check_suggests("forecast") From 64e45b74673dedbbebd67e53f004dca66d8246b3 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Wed, 20 May 2020 17:01:27 +0200 Subject: [PATCH 6/9] updated documentation --- R/model-wrappers.R | 1 + man/forecastHybrid_model.Rd | 2 +- man/forecast_model.Rd | 26 +++++++++++++++++++++++--- 3 files changed, 25 insertions(+), 4 deletions(-) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index 270daf2..5da0700 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -300,6 +300,7 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, #' Note that `forecast` must be installed for this model wrapper to be functional. #' @param model A `forecast` model object. #' @inheritParams bsts_model +#' @param ... pass further arguments to the forecast models #' @export #' @return A dataframe of predictions (with columns representing the #' time horizon and rows representing samples). diff --git a/man/forecastHybrid_model.Rd b/man/forecastHybrid_model.Rd index a59f9cc..190c037 100644 --- a/man/forecastHybrid_model.Rd +++ b/man/forecastHybrid_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{forecastHybrid_model} \alias{forecastHybrid_model} -\title{forecastHybrid model wrapper} +\title{ForecastHybrid model wrapper} \usage{ forecastHybrid_model( y = NULL, diff --git a/man/forecast_model.Rd b/man/forecast_model.Rd index 670528b..3f27990 100644 --- a/man/forecast_model.Rd +++ b/man/forecast_model.Rd @@ -2,9 +2,9 @@ % Please edit documentation in R/model-wrappers.R \name{forecast_model} \alias{forecast_model} -\title{forecast model wrapper} +\title{Forecast model wrapper} \usage{ -forecast_model(y = NULL, samples = NULL, horizon = NULL, model = NULL) +forecast_model(y = NULL, samples = NULL, horizon = NULL, model = NULL, ...) } \arguments{ \item{y}{Numeric vector of time points to forecast} @@ -14,13 +14,15 @@ forecast_model(y = NULL, samples = NULL, horizon = NULL, model = NULL) \item{horizon}{Numeric, the time horizon over which to predict.} \item{model}{A \code{forecast} model object.} + +\item{...}{pass further arguments to the forecast models} } \value{ A dataframe of predictions (with columns representing the time horizon and rows representing samples). } \description{ -Allows users to forecast using models from the \code{forecast} +Allows users to forecast using models from the \code{forecast} package. Note that \code{forecast} must be installed for this model wrapper to be functional. } \examples{ @@ -36,6 +38,24 @@ forecast_rt(EpiSoon::example_obs_rts[1:10, ], model = function(...){ forecast_model(model = forecast::ets, ...)}, horizon = 7, samples = 10) + + + +models <- list("ARIMA" = function(...) {forecast_model(model = forecast::auto.arima, ...)}, + "ETS" = function(...) {forecast_model(model = forecast::ets, ...)}, + "TBATS" = function(...) {forecast_model(model = forecast::tbats, ...)}) + +## Compare models +evaluations <- compare_models(EpiSoon::example_obs_rts, + EpiSoon::example_obs_cases, models, + horizon = 7, samples = 10, + serial_interval = example_serial_interval) + +plot_forecast_evaluation(evaluations$forecast_rts, + EpiSoon::example_obs_rts, + horizon_to_plot = 7) + +ggplot2::facet_grid(~ model) + +cowplot::panel_border() } } From 0b5795f665040cf5f71dbe480c8c7fa16ffd1a2b Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Thu, 21 May 2020 17:59:12 +0200 Subject: [PATCH 7/9] edited code and added example for passing down further arguments to the model function --- R/model-wrappers.R | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index 2c96e33..450359c 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -201,7 +201,7 @@ fable_model <- function(y = NULL, samples = NULL, return(samples) } -#' ForecastHybrid model wrapper +#' forecastHybrid model wrapper #' #' Allows users to forecast using ensembles from the `forecastHybrid` package. Note that #' whilst weighted ensembles can be created this is not advised when samples > 1 as currently @@ -315,13 +315,18 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, #' model = forecast::auto.arima, #' samples = 10, horizon = 7) #' -#' +#' ## Used for forecasting #' forecast_rt(EpiSoon::example_obs_rts[1:10, ], #' model = function(...){ #' forecast_model(model = forecast::ets, ...)}, #' horizon = 7, samples = 10) #' -#' +#' # run with non-default arguments +#' forecast_rt(EpiSoon::example_obs_rts[1:10, ], +#' model = function(...){ +#' forecast_model(model = forecast::ets, +#' damped = TRUE, ...)}, +#' horizon = 7, samples = 10) #' #' models <- list("ARIMA" = function(...) {forecast_model(model = forecast::auto.arima, ...)}, #' "ETS" = function(...) {forecast_model(model = forecast::ets, ...)}, @@ -351,7 +356,7 @@ forecast_model <- function(y = NULL, samples = NULL, timeseries <- stats::ts(y) # fit and forecast - fit <- model(timeseries) + fit <- model(timeseries, ...) prediction <- forecast::forecast(fit, h = horizon) ## Extract samples and tidy format From f35af09e746d4f9fd3b344e22ee96adc1da95461 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Thu, 21 May 2020 18:35:09 +0200 Subject: [PATCH 8/9] updated documentation to eliminate CRAN warning --- R/model-wrappers.R | 6 +++--- man/forecastHybrid_model.Rd | 2 +- man/forecast_model.Rd | 9 +++++++-- man/stackr_model.Rd | 6 +++--- 4 files changed, 14 insertions(+), 9 deletions(-) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index 450359c..c60e6f2 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -396,9 +396,9 @@ forecast_model <- function(y = NULL, samples = NULL, #' models. Draws from the individual model predictive samples are then used #' to generate a mixture model with the weights obtained in the previous step. #' -#' The weights are computed using \code{\link[stackr]{stack_crps}} from -#' the package `stackr` to minimise CRPS. The function -#' \code{\link[stackr]{mixture_from_sample}} from the same package is used +#' The weights are computed using \code{\link[stackr]{crps_weights}} from +#' the package `stackr`to minimise CRPS. The function +#' \code{\link[stackr]{mixture_from_samples}} from the same package is used #' to draw samples from the #' individual models to form the mixture models. #' diff --git a/man/forecastHybrid_model.Rd b/man/forecastHybrid_model.Rd index 190c037..a59f9cc 100644 --- a/man/forecastHybrid_model.Rd +++ b/man/forecastHybrid_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{forecastHybrid_model} \alias{forecastHybrid_model} -\title{ForecastHybrid model wrapper} +\title{forecastHybrid model wrapper} \usage{ forecastHybrid_model( y = NULL, diff --git a/man/forecast_model.Rd b/man/forecast_model.Rd index 3f27990..e83b8ba 100644 --- a/man/forecast_model.Rd +++ b/man/forecast_model.Rd @@ -33,13 +33,18 @@ forecast_model(y = EpiSoon::example_obs_rts[1:10, ]$rt, model = forecast::auto.arima, samples = 10, horizon = 7) - +## Used for forecasting forecast_rt(EpiSoon::example_obs_rts[1:10, ], model = function(...){ forecast_model(model = forecast::ets, ...)}, horizon = 7, samples = 10) - +# run with non-default arguments +forecast_rt(EpiSoon::example_obs_rts[1:10, ], + model = function(...){ + forecast_model(model = forecast::ets, + damped = TRUE, ...)}, + horizon = 7, samples = 10) models <- list("ARIMA" = function(...) {forecast_model(model = forecast::auto.arima, ...)}, "ETS" = function(...) {forecast_model(model = forecast::ets, ...)}, diff --git a/man/stackr_model.Rd b/man/stackr_model.Rd index 7c99fe3..1d75518 100644 --- a/man/stackr_model.Rd +++ b/man/stackr_model.Rd @@ -48,9 +48,9 @@ refitted for the entire timeseries and predictions are generated from these models. Draws from the individual model predictive samples are then used to generate a mixture model with the weights obtained in the previous step. -The weights are computed using \code{\link[stackr]{stack_crps}} from -the package \code{stackr} to minimise CRPS. The function -\code{\link[stackr]{mixture_from_sample}} from the same package is used +The weights are computed using \code{\link[stackr]{crps_weights}} from +the package \code{stackr}to minimise CRPS. The function +\code{\link[stackr]{mixture_from_samples}} from the same package is used to draw samples from the individual models to form the mixture models. } From 939a57219e5c9613c194d5b33af7f0ef28165d0b Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Thu, 21 May 2020 21:02:32 +0200 Subject: [PATCH 9/9] updated title case in model-wrappers.R --- R/model-wrappers.R | 12 ++++++------ man/brms_model.Rd | 2 +- man/bsts_model.Rd | 4 ++-- man/fable_model.Rd | 2 +- man/forecastHybrid_model.Rd | 2 +- man/forecast_model.Rd | 2 +- man/stackr_model.Rd | 2 +- 7 files changed, 13 insertions(+), 13 deletions(-) diff --git a/R/model-wrappers.R b/R/model-wrappers.R index c60e6f2..8d9300a 100644 --- a/R/model-wrappers.R +++ b/R/model-wrappers.R @@ -1,4 +1,4 @@ -#' BSTS model wrapper +#' bsts Model Wrapper #' #' @param y Numeric vector of time points to forecast #' @param samples Numeric, number of samples to take. @@ -51,7 +51,7 @@ bsts_model <- function(y = NULL, samples = NULL, } -#' brms model wrapper +#' brms Model Wrapper #' #' Allows users to specify a model using the [brms::bf()] wrapper from `brms` #' Note that `brms` and `tidybayes` must both be installed for this @@ -128,7 +128,7 @@ brms_model <- function(y = NULL, samples = NULL, } -#' Fable model wrapper +#' fable Model Wrapper #' #' #' @description Provides an interface for models from the `fable` package. @@ -201,7 +201,7 @@ fable_model <- function(y = NULL, samples = NULL, return(samples) } -#' forecastHybrid model wrapper +#' forecastHybrid Model Wrapper #' #' Allows users to forecast using ensembles from the `forecastHybrid` package. Note that #' whilst weighted ensembles can be created this is not advised when samples > 1 as currently @@ -293,7 +293,7 @@ forecastHybrid_model <- function(y = NULL, samples = NULL, -#' Forecast model wrapper +#' forecast Model Wrapper #' #' Allows users to forecast using models from the `forecast` package. #' Note that `forecast` must be installed for this model wrapper to be functional. @@ -380,7 +380,7 @@ forecast_model <- function(y = NULL, samples = NULL, } -#' Stack models according to CRPS +#' Stack Models According to CRPS #' #' @description #' Provides a wrapper for different EpiSoon model wrappers and generates diff --git a/man/brms_model.Rd b/man/brms_model.Rd index d7c08f2..04f4220 100644 --- a/man/brms_model.Rd +++ b/man/brms_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{brms_model} \alias{brms_model} -\title{brms model wrapper} +\title{brms Model Wrapper} \usage{ brms_model( y = NULL, diff --git a/man/bsts_model.Rd b/man/bsts_model.Rd index 9f3a548..76ab90d 100644 --- a/man/bsts_model.Rd +++ b/man/bsts_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{bsts_model} \alias{bsts_model} -\title{BSTS model wrapper} +\title{bsts Model Wrapper} \usage{ bsts_model(y = NULL, samples = NULL, horizon = NULL, model = NULL) } @@ -19,7 +19,7 @@ bsts_model(y = NULL, samples = NULL, horizon = NULL, model = NULL) A dataframe of predictions (with columns representing the time horizon and rows representing samples). } \description{ -BSTS model wrapper +bsts Model Wrapper } \examples{ \dontrun{ diff --git a/man/fable_model.Rd b/man/fable_model.Rd index 6d6f834..a87a075 100644 --- a/man/fable_model.Rd +++ b/man/fable_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{fable_model} \alias{fable_model} -\title{Fable model wrapper} +\title{fable Model Wrapper} \usage{ fable_model(y = NULL, samples = NULL, horizon = NULL, model = NULL) } diff --git a/man/forecastHybrid_model.Rd b/man/forecastHybrid_model.Rd index a59f9cc..b31922d 100644 --- a/man/forecastHybrid_model.Rd +++ b/man/forecastHybrid_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{forecastHybrid_model} \alias{forecastHybrid_model} -\title{forecastHybrid model wrapper} +\title{forecastHybrid Model Wrapper} \usage{ forecastHybrid_model( y = NULL, diff --git a/man/forecast_model.Rd b/man/forecast_model.Rd index e83b8ba..d6cf82a 100644 --- a/man/forecast_model.Rd +++ b/man/forecast_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{forecast_model} \alias{forecast_model} -\title{Forecast model wrapper} +\title{forecast Model Wrapper} \usage{ forecast_model(y = NULL, samples = NULL, horizon = NULL, model = NULL, ...) } diff --git a/man/stackr_model.Rd b/man/stackr_model.Rd index 1d75518..cf07673 100644 --- a/man/stackr_model.Rd +++ b/man/stackr_model.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/model-wrappers.R \name{stackr_model} \alias{stackr_model} -\title{Stack models according to CRPS} +\title{Stack Models According to CRPS} \usage{ stackr_model( y = NULL,