adding a custom forecast function that extends snaive

Question

I would like to extend snaive from the forecast package (or maybe lagwalk?) and add a custom forecast function custom_snaive.

I would like it to get as a parameter a list of desired_lags and forecast a simple average of their values. E.g. for hourly data, the following call: custom_snaive(lags=c(24, 48, 24*7)) would return a simple average of the values from 1 day ago, 2 days ago and a week ago.

How would you go about implementing such a function? should I rewrite snaive and use lagwalk? I do not care about prediction intervals currently.

(related to How to create a forecast object in R but simpler)

Answer 1

I've followed the baggedModel example. I called lagwalk for every lag and then tricked forecast to think that this is a baggedModel, as it's pretty similar (only it's just aggregation, no bootstrapping here). Would appreciate a code review by someone who knows the forecast package, is there anything simpler I could have used?

historical_mean_model <- function(y, lags, lambda=NULL, biasadj=FALSE, ..., x=y) {
  out <- list()
  out$y <- as.ts(y)
  out$modelargs <- list(...)
  out$models <- lapply(lags, function(lag) {
    mod <- forecast:::lagwalk(
      x, lag = lag, drift = FALSE,
      lambda = lambda, biasadj = biasadj, ...
    )
  })
  fitted_all_lags <- lapply(out$models, fitted)
  fitted_all_lags <- as.matrix(as.data.frame(fitted_all_lags))
  out$fitted <- ts(apply(fitted_all_lags, 1, mean))
  tsp(out$fitted) <- tsp(out$y)
  out$residuals <- out$y - out$fitted

  out$series <- deparse(substitute(y))
  out$method <- "historical_mean_model"

  out$call <- match.call()
  return(structure(out, class = c("baggedModel")))
}