From 933816c7626b96d95c625a81c07f8c91f93bbad7 Mon Sep 17 00:00:00 2001
From: mitchelloharawild <mitch.ohara-wild@monash.edu>
Date: Fri, 13 Sep 2024 08:55:14 +1000
Subject: [PATCH] Add generate method for VAR

---
 DESCRIPTION         |  2 +-
 NAMESPACE           |  1 +
 NEWS.md             |  4 ++++
 R/var.R             | 48 +++++++++++++++++++++++++++++++++++++++++++++
 man/generate.VAR.Rd | 31 +++++++++++++++++++++++++++++
 5 files changed, 85 insertions(+), 1 deletion(-)
 create mode 100644 man/generate.VAR.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index 620c9300..951625b9 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -67,4 +67,4 @@ Encoding: UTF-8
 Language: en-GB
 Roxygen: list(markdown = TRUE, roclets=c('rd', 'collate',
     'namespace'))
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
diff --git a/NAMESPACE b/NAMESPACE
index 47c7bde5..90d378f4 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -28,6 +28,7 @@ S3method(generate,ETS)
 S3method(generate,NNETAR)
 S3method(generate,RW)
 S3method(generate,TSLM)
+S3method(generate,VAR)
 S3method(generate,model_mean)
 S3method(glance,AR)
 S3method(glance,ARIMA)
diff --git a/NEWS.md b/NEWS.md
index 7f4424ca..77d4b831 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,9 @@
 # fable (development version)
 
+## New features
+
+* Added generate() method for VAR models
+
 # fable 0.3.4
 
 Small patch to resolve issues in C++ R headers.
diff --git a/R/var.R b/R/var.R
index 8c4962b3..ff80d3a3 100644
--- a/R/var.R
+++ b/R/var.R
@@ -381,3 +381,51 @@ report.VAR <- function(object, ...) {
     )
   )
 }
+
+#' @inherit generate.ETS
+#' 
+#' @export
+generate.VAR <- function(x, new_data, specials, ...){
+  if (!".innov" %in% names(new_data)) {
+    new_data[[".innov"]] <- generate(distributional::dist_multivariate_normal(list(matrix(0, ncol = K)), x$fit$sigma2), nrow(new_data))[[1L]]
+  }
+  
+  kr <- key_data(new_data)$.rows
+  h <- lengths(kr)
+  p <- x$spec$p
+  coef <- x$coef
+  K <- NCOL(coef)
+  
+  # Get xreg
+  xreg <- specials$xreg[[1]]$xreg
+  
+  # Generate paths
+  var_sim <- function(i) {
+    if (x$spec$constant) {
+      xreg <- cbind(constant = rep_len(1, length(i)), xreg)
+    }
+    
+    .innov <- new_data$.innov[i,]
+    
+    .sim <- matrix(NA, nrow = h, ncol = K)
+    y_lag <- matrix(0, nrow = p, ncol = K)
+    y_lag <- x$last_obs
+    for (i in seq_len(h)) {
+      if (is.null(xreg)) {
+        Z <- c(t(y_lag))
+      }
+      else {
+        Z <- c(t(y_lag), t(xreg[i, ]))
+      }
+      .sim[i, ] <- t(coef) %*% Z + .innov[i,]
+      y_lag <- rbind(.sim[i, , drop = FALSE], y_lag)[seq_len(p), , drop = FALSE]
+    }
+    
+    .sim
+  }
+  
+  .sim <- do.call(rbind, lapply(kr, var_sim))
+  
+  new_data[colnames(coef)] <- split(.sim, col(.sim))
+  new_data
+}
diff --git a/man/generate.VAR.Rd b/man/generate.VAR.Rd
new file mode 100644
index 00000000..1ce57391
--- /dev/null
+++ b/man/generate.VAR.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/var.R
+\name{generate.VAR}
+\alias{generate.VAR}
+\title{Generate new data from a fable model}
+\usage{
+\method{generate}{VAR}(x, new_data, specials, ...)
+}
+\arguments{
+\item{x}{A fitted model.}
+
+\item{new_data}{A tsibble containing the time points and exogenous regressors to produce forecasts for.}
+
+\item{specials}{(passed by \code{\link[fabletools:forecast]{fabletools::forecast.mdl_df()}}).}
+
+\item{...}{Other arguments passed to methods}
+}
+\description{
+Simulates future paths from a dataset using a fitted model. Innovations are
+sampled by the model's assumed error distribution. If \code{bootstrap} is \code{TRUE},
+innovations will be sampled from the model's residuals. If \code{new_data}
+contains the \code{.innov} column, those values will be treated as innovations.
+}
+\examples{
+as_tsibble(USAccDeaths) \%>\%
+  model(ETS(log(value) ~ season("A"))) \%>\%
+  generate(times = 100)
+}
+\seealso{
+\code{\link[fabletools:generate.mdl_df]{fabletools::generate.mdl_df}}
+}