R/ts_lm_mv.R

In tspredit: Time Series Prediction with Integrated Tuning

#'@title Multivariate Linear Regression
#'@description Create a target-centered singular multivariate regressor based on
#' `stats::lm`.
#'
#'@details
#' `ts_lm_mv()` is a linear-regression member of the `ts_reg_mv` family.
#'
#' It is inspired by the formula-based design already used in `daltoolbox`,
#' but adapted to the aligned multivariate time-series abstraction of
#' `tspredit`.
#'
#' This makes it a very transparent baseline for the singular multivariate
#' branch:
#' - the target variable remains explicit
#' - the auxiliary variables are declared in the formula
#' - the analyst can read the structural assumption directly from the model
#'
#' The most common usage patterns are:
#' - provide a full formula such as `y ~ x1 + x2`
#' - omit the formula and let the model regress `y` on all auxiliary variables
#'
#' The target variable is forecast from the synchronized auxiliary variables.
#' When future auxiliary values are not known, they can be generated by the
#' univariate models supplied in `models_x`.
#'
#'@param models_x Optional named list with one univariate model per auxiliary
#' variable.
#'@param formula Optional regression formula. When omitted, the target variable
#' from `ts_data_mv` is regressed on all auxiliary variables.
#'@param features Optional character vector of feature names used when `formula`
#' is `NULL`.
#'@return A `ts_lm_mv` object inheriting from `ts_reg_mv`.
#'@references
#' - Montgomery DC, Peck EA, Vining GG (2021). Introduction to Linear
#'   Regression Analysis. Wiley.
#'@examples
#'data(tsd)
#'x1 <- c(tsd$y[-1], tail(tsd$y, 1))
#'x2 <- stats::filter(tsd$y, rep(1/3, 3), sides = 1)
#'x2[is.na(x2)] <- tsd$y[is.na(x2)]
#'
#'mv <- ts_data_mv(data.frame(y = tsd$y, x1 = x1, x2 = as.numeric(x2)), y = "y")
#'samp <- ts_sample(mv, test_size = 5)
#'
#'model <- ts_lm_mv(
#'  models_x = list(x1 = ts_arima(), x2 = ts_arima()),
#'  formula = y ~ x1 + x2
#' )
#'model <- daltoolbox::fit(model, samp$train)
#'predict(model, steps_ahead = 5)
#'@export
ts_lm_mv <- function(models_x = NULL, formula = NULL, features = NULL) {
  obj <- ts_reg_mv(models_x = models_x)
  obj$formula <- formula
  obj$features <- features
  class(obj) <- append("ts_lm_mv", class(obj))
  obj
}

#'@exportS3Method fit ts_lm_mv
#'@inheritParams do_fit
#'@return A fitted `ts_lm_mv` object.
#'@noRd
fit.ts_lm_mv <- function(obj, x, y = NULL, ...) {
  x <- reg_mv_validate_data(x)
  obj <- reg_mv_set_metadata(obj, x)
  obj <- reg_mv_validate_models_x(obj, x)
  obj <- reg_mv_fit_aux_models(obj, as.data.frame(x))

  data <- as.data.frame(x)
  if (is.null(obj$formula)) {
    features <- obj$features
    if (is.null(features)) {
      features <- obj$x_names
    }
    obj$formula <- stats::formula(
      paste(obj$y_name, "~", paste(features, collapse = " + "))
    )
  }

  obj$model <- stats::lm(obj$formula, data = data)
  formula_vars <- all.vars(obj$formula)
  obj$feature_names <- intersect(formula_vars[-1], names(data))
  attr(obj, "params") <- list(formula = deparse(obj$formula))
  obj
}

#'@exportS3Method predict ts_lm_mv
#'@inheritParams do_predict
#'@param steps_ahead Integer. Forecast horizon.
#'@param return_all Logical. Ignored for compatibility. The method always
#' returns the target forecast as a vector with the full multivariate forecast
#' attached as attributes.
#'@return Numeric vector with target forecasts. The full multivariate forecast
#' is attached as attributes.
#'@noRd
predict.ts_lm_mv <- function(object, x = NULL, steps_ahead = 1, return_all = FALSE, ...) {
  steps_ahead <- as.integer(steps_ahead)
  future_x <- reg_mv_forecast_aux(object, x = x, steps_ahead = steps_ahead)
  prediction_y <- as.vector(stats::predict(object$model, newdata = future_x))

  object$history <- reg_mv_update_history(object, future_x, prediction_y)

  prediction_x <- as.list(future_x)
  mv_compose_prediction(object, prediction_y, prediction_x)
}