Add support for stlm()

.travis.yml

@@ -1,6 +1,10 @@
 # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r
 
 language: r
+r:
+  - 3.6.0
+  - release
+  - devel
 warnings_are_errors: true
 sudo: required
 

NAMESPACE

@@ -8,6 +8,7 @@ S3method(sw_augment,default)
 S3method(sw_augment,ets)
 S3method(sw_augment,nnetar)
 S3method(sw_augment,robets)
+S3method(sw_augment,stlm)
 S3method(sw_glance,Arima)
 S3method(sw_glance,HoltWinters)
 S3method(sw_glance,StructTS)
@@ -16,6 +17,7 @@ S3method(sw_glance,default)
 S3method(sw_glance,ets)
 S3method(sw_glance,nnetar)
 S3method(sw_glance,robets)
+S3method(sw_glance,stlm)
 S3method(sw_sweep,default)
 S3method(sw_sweep,forecast)
 S3method(sw_tidy,Arima)
@@ -27,6 +29,7 @@ S3method(sw_tidy,ets)
 S3method(sw_tidy,nnetar)
 S3method(sw_tidy,robets)
 S3method(sw_tidy,stl)
+S3method(sw_tidy,stlm)
 S3method(sw_tidy_decomp,HoltWinters)
 S3method(sw_tidy_decomp,bats)
 S3method(sw_tidy_decomp,decomposed.ts)

NEWS.md

@@ -1,13 +1,18 @@
 # sweep 0.2.3
+
 * Fixes for compatability with `broom` v0.7.0
+* Add tidiers for `stlm()` models
 
 # sweep 0.2.2
+
 * Fixes for compatability with `tidyquant` v0.5.7
 
 # sweep 0.2.1
+
 * Fixes for `forecast::mstl`
 
 # sweep 0.2.0
+
 * Change to `timetk` from `timekit`.
 * Fix Issue #2 - `sw_tidy` fails when `auto.arima()` returns no terms (coefficients).
 

R/tidiers_stl.R

@@ -1,7 +1,7 @@
 #' Tidying methods for STL (Seasonal, Trend, Level) decomposition of time series
 #'
 #'
-#' @param x An object of class "stl" or "stlm"
+#' @param x An object of class "stl"
 #' @param rename_index Used with `sw_tidy_decomp`.
 #' A string representing the name of the index generated.
 #' @param timetk_idx Used with `sw_tidy_decomp`.
@@ -91,3 +91,84 @@ sw_tidy_decomp.stlm <- function(x, timetk_idx = FALSE, rename_index = "index", .
 
     return(ret)
 }
+
+#' @rdname tidiers_arima
+#'
+#' @param ... Additional parameters (not used)
+#'
+#' @return
+#' __`sw_tidy()`__ returns the underlying ETS or ARIMA model's `sw_tidy()`
+#' one row for each coefficient in the model,
+#' with five columns:
+#'   * `term`: The term in the nonlinear model being estimated and tested
+#'   * `estimate`: The estimated coefficient
+#'
+#' @export
+sw_tidy.stlm <- function(x, ...) {
+
+    sw_tidy(x$model)
+}
+
+#' @rdname tidiers_stl
+#'
+#' @return
+#' __`sw_glance()`__ returns the underlying ETS or ARIMA model's `sw_glance()` results one row with the columns
+#' * `model.desc`: A description of the model including the
+#'   three integer components (p, d, q) are the AR order,
+#'   the degree of differencing, and the MA order.
+#' * `sigma`: The square root of the estimated residual variance
+#' * `logLik`: The data's log-likelihood under the model
+#' * `AIC`: The Akaike Information Criterion
+#' * `BIC`: The Bayesian Information Criterion
+#' * `ME`: Mean error
+#' * `RMSE`: Root mean squared error
+#' * `MAE`: Mean absolute error
+#' * `MPE`: Mean percentage error
+#' * `MAPE`: Mean absolute percentage error
+#' * `MASE`: Mean absolute scaled error
+#' * `ACF1`: Autocorrelation of errors at lag 1
+#'
+#' @export
+sw_glance.stlm <- function(x, ...) {
+    sw_glance(x$model)
+}
+
+#' @rdname tidiers_stl
+#'
+#' @param data Used with `sw_augment` only.
+#'
+#' @return
+#' __`sw_augment()`__ returns a tibble with the following time series attributes:
+#'   * `index`: An index is either attempted to be extracted from the model or
+#'   a sequential index is created for plotting purposes
+#'   * `.actual`: The original time series
+#'   * `.fitted`: The fitted values from the model
+#'   * `.resid`: The residual values from the model
+#'
+#' @export
+sw_augment.stlm <- function(x, data = NULL, rename_index = "index", timetk_idx = FALSE, ...) {
+
+    # Check timetk_idx
+    if (timetk_idx) {
+        if (!has_timetk_idx(x$model)) {
+            warning("Object has no timetk index. Using default index.")
+            timetk_idx = FALSE
+        }
+    }
+
+    # Convert model to tibble
+    ret <- tk_tbl(cbind(.actual = x$x, .fitted = x$fitted, .resid = x$residuals),
+                  rename_index = rename_index, silent = TRUE)
+
+    # Apply timetk index if selected
+    if (timetk_idx) {
+        idx <- tk_index(x$model, timetk_idx = TRUE)
+        ret[, rename_index] <- idx
+    }
+
+    # Augment columns if necessary
+    ret <- sw_augment_columns(ret, data, rename_index, timetk_idx)
+
+    return(ret)
+
+}