Merge pull request #950 from mitchelloharawild/hfitted-ets

Added faster and better hfitted method for ETS model

NAMESPACE

@@ -81,6 +81,7 @@ S3method(getResponse,mforecast)
 S3method(getResponse,tbats)
 S3method(head,ts)
 S3method(hfitted,default)
+S3method(hfitted,ets)
 S3method(logLik,ets)
 S3method(nobs,ets)
 S3method(plot,Arima)

NEWS.md

@@ -1,6 +1,7 @@
 # forecast (development version)
   * hfitted now much faster for ARIMA models (danigiro, #949)
-
+  * hfitted now much faster for ETS models, and produces fitted values from 
+    initial states (#950)
 
 # forecast 8.21.1
   * nnetar now allows p or P to be 0

R/ets.R

@@ -1346,6 +1346,26 @@ fitted.ets <- function(object, h=1, ...) {
   }
 }
 
+#' @export
+hfitted.ets <- function(object, h=1, ...) {
+  n <- length(object$x)
+  out <- rep(NA_real_, n)
+  for(i in seq_len(n-h+1)) {
+    out[i+h-1] <- .C(
+      "etsforecast",
+      as.double(object$states[i, ]),
+      as.integer(object$m),
+      as.integer(switch(object$components[2], "N" = 0, "A" = 1, "M" = 2)),
+      as.integer(switch(object$components[3], "N" = 0, "A" = 1, "M" = 2)),
+      as.double(ifelse(object$components[4] == "FALSE", 1, object$par["phi"])),
+      as.integer(h),
+      as.double(numeric(h)),
+      PACKAGE = "forecast"
+    )[[7]][h]
+  }
+  out
+}
+
 #' @export
 logLik.ets <- function(object, ...) {
   structure(object$loglik, df = length(object$par) + 1, class = "logLik")