Merge 05449e9 into e229d28

.travis.yml

@@ -17,13 +17,5 @@ cache: packages
 before_install:
   - cd pkg
 
-install:
-  - Rscript -e 'install.packages(c("devtools", "covr"), repos = "https://cloud.r-project.org")'
-  - Rscript -e 'devtools::install_deps(dependencies = TRUE, threads = 2, repos = "https://cloud.r-project.org")'
-
-script:
-  - Rscript -e 'devtools::check()'
-
-
 after_success:
   - Rscript -e 'covr::coveralls()'

pkg/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: forecastHybrid
 Title: Convenient Functions for Ensemble Time Series Forecasts
-Version: 3.0.14
-Date: 2018-07-22
+Version: 4.0.15
+Date: 2018-11-06
 Authors@R: c(
    person("David", "Shaub", email = "davidshaub@gmx.com", role = c("aut", "cre")),
    person("Peter", "Ellis", email = "peter.ellis2013nz@gmail.com", role = c("aut"))

pkg/R/forecast.hybridModel.R

@@ -70,14 +70,14 @@ forecast.hybridModel <- function(object,
 
   # xreg should be a matrix and have same number of observations as the horizon
   if(!is.null(xreg)){
-    if(!is.matrix(xreg) && !is.data.frame(xreg)){
-      stop("The supplied xreg must be a matrix or data.frame.")
+    if(!is.matrix(xreg) && !is.numeric(xreg) && !is.data.frame(xreg)){
+      stop("The supplied xreg must be numeric, matrix, or data.frame.")
     }
     xreg <- as.matrix(xreg)
     if(!is.numeric(xreg)){
       stop("The supplied xreg must be numeric.")
     }
-    if(nrow(xreg) != h){
+    if(is.null(h) || nrow(xreg) != h){
       warning("The number of rows in xreg should match h. Setting h to nrow(xreg).")
       h <- nrow(xreg)
     }
@@ -132,7 +132,7 @@ forecast.hybridModel <- function(object,
     xregN <- xreg
     if(!object$xreg$nnetar){
       xregN <- NULL
-      }
+    }
     forecasts$nnetar <- forecast(object$nnetar, h = h, xreg = xregN, PI = PI, level = level, ...)
     forecasts$pointForecasts[, "nnetar"] <- forecasts$nnetar$mean
   }
@@ -142,7 +142,7 @@ forecast.hybridModel <- function(object,
     # xreg is only used in stlm if method = "arima"
     if(!object$xreg$stlm){
       xregS <- NULL
-      }
+    }
     forecasts$stlm <- forecast(object$stlm, h = h, xreg = xregS, level = level, ...)
     forecasts$pointForecasts[, "stlm"] <- forecasts$stlm$mean
   }
@@ -176,22 +176,22 @@ forecast.hybridModel <- function(object,
     piCombination <- match.arg(PI.combination)
     if(piCombination == "mean"){
       upperFunction <- lowerFunction <- mean
-    } else{
+    } else if(piCombination == "extreme"){
       upperFunction <- max
       lowerFunction <- min
     }
      nint <- length(level)
      upper <- lower <- matrix(NA, ncol = nint, nrow = length(finalForecast))
-     # Prediction intervals for nnetar do not currently work, so exclude these
-     piModels <- object$models#[object$models != "nnetar"]
+
+     piModels <- object$models
      # Produce each upper/lower limit
      for(i in 1:nint){
         # Produce the upper/lower limit for each model for a given level
         tmpUpper <- tmpLower <- matrix(NA, nrow = h, ncol = length(piModels))
         j2 <- 1
-        for(j in piModels){
-           tmpUpper[, j2] <- as.numeric(matrix(forecasts[[j]]$upper, nrow = h)[, i])
-           tmpLower[, j2] <- as.numeric(matrix(forecasts[[j]]$lower, nrow = h)[, i])
+        for(mod in piModels){
+           tmpUpper[, j2] <- as.numeric(matrix(forecasts[[mod]]$upper, nrow = h)[, i])
+           tmpLower[, j2] <- as.numeric(matrix(forecasts[[mod]]$lower, nrow = h)[, i])
            j2 <- j2 + 1
         }
         # Apply the function for reconciling the prediction intervals

pkg/R/hybridModel.R

@@ -54,9 +54,9 @@
 #' in most cases, fine control can be exerted by passing detailed arguments to the component models in the
 #' \code{a.args}, \code{e.args}, \code{n.args}, \code{s.args}, and \code{t.args} lists.
 #' Note that if \code{xreg} is passed to the \code{a.args}, \code{n.args}, or \code{s.args} component models
-#' it must be passed as a dataframe instead of the matrix object
-#' that the "forecast" package functions usually accept.
-#' This is due to a limitation in how the component models are called.
+#' it must now be passed as a matrix. In "forecastHybrid" versions earlier than 4.0.15 it would
+#' instead be passed in as a dataframe, but for consistency with "forecast" v8.5 we now require
+#' a matrix with colnames
 #' \cr
 #' \cr
 #' Characteristics of the input series can cause problems for certain types of models and paramesters.

pkg/inst/NEWS.md

@@ -1,3 +1,6 @@
+# Version 4.0.15 [Unreleased]
+* The `xreg` argument passed in must now be a matrix instead of a dataframe for consistency with "forecast" v8.5.
+
 # Version 3.0.14 [2018-07-22]
 * Parallel support added to `hybridModel()`. This can be controlled by setting `parallel = TRUE` and setting `num.cores`. By default this is not enabled since the performance improvement typically only occurs when fitting `auto.arima` and `tbats` models on long series with large frequency (e.g. `taylor`).
 * Added `z.args` for the `snaive()` model.

pkg/tests/testthat/test-forecast.hybridModel.R

@@ -2,20 +2,23 @@
 if(require(forecast) &  require(testthat)){
   context("Testing input for forecast.hybridModel()")
   test_that("Testing invalid inputs", {
-    inputSeries <- ts(rnorm(6), f = 2)
+    inputSeries <- ts(rnorm(24), f = 2)
     hModel <- hybridModel(inputSeries)
+    # time series too short
     expect_error(hybridModel(1:3, models = "ae"))
     # h must be positive
     expect_error(forecast(object = hModel, h = -1L))
     # h must be numeric
     expect_error(forecast(object = hModel, h = "a"))
     # h should be an integer
     expect_error(forecast(object = hModel, h = 3.2))
+    # xreg should be a matrix
+    expect_error(forecast(object = hModel, xreg = "1"))
     # matrix should be numeric
     expect_error(forecast(object = hModel, h = 5,
                                      xreg = matrix("a", nrow = 5, ncol = 2)))
-    expect_error(forecast(object = hModel, h = 5,
-                                     xreg = 1:12))
+#~     expect_error(forecast(object = hModel, h = 5,
+#~                                      xreg = 1:12))
     # s3 forecast method should take a hybridModel object only
     expect_error(forecast.hybridModel("a"))
   })
@@ -42,13 +45,25 @@ if(require(forecast) &  require(testthat)){
 
   test_that("Testing forecasts with xreg", {
     # Test a simple et model
+    set.seed(5)
     inputSeries <- ts(rnorm(5), f = 2)
     hm <- hybridModel(inputSeries, models = "et")
     expect_error(forecast(hm), NA)
 
     # Test xregs
-    inputSeries <- subset(wineind, end = 25)
+    inputSeries <- subset(wineind, end = 48)
+    testLength <- 12
     mm <- matrix(runif(length(inputSeries)), nrow = length(inputSeries))
+    fm <- matrix(runif(testLength), nrow = testLength)
+    hm <- hybridModel(inputSeries, models = "af",
+                      a.args = list(xreg = mm))
+    fc <- forecast(hm, h = testLength, xreg = fm)
+    # No xreg provided
+    expect_error(forecast(hm, h = testLength))
+    fc <- forecast(hm, h = testLength, xreg = fm)
+    expect_true(all(fc$mean > 0))
+    expect_true(length(fc$mean) == testLength)
+
     # stlm only works with xreg when method = "arima" is passed in s.args
     expect_error(aa <- hybridModel(inputSeries, models = "afns",
                                    a.args = list(xreg = mm),
@@ -64,7 +79,7 @@ if(require(forecast) &  require(testthat)){
     expect_equal(length(tmp$mean), nrow(newXreg))
     # If nrow(xreg) != h, issue a warning but set h <- nrow(xreg)
     expect_warning(forecast(aa, h = 10, xreg = newXreg, PI = FALSE))
-    
+
     # Fit the model using xreg for only one individual component
     # Forecast should still work (previous bug)
     mod <- hybridModel(inputSeries, models = "af", a.args = list(xreg = mm))
@@ -86,5 +101,70 @@ if(require(forecast) &  require(testthat)){
     fc <- forecast(aa, xreg = newXreg, h = nrow(newXreg), fan = TRUE)
     expect_true(ncol(fc$upper) == 17)
     expect_true(ncol(fc$lower) == 17)
+    })
+
+
+    test_that("More forecast xreg tests", {
+    # forecast xreg with multiple meaningful xreg
+    set.seed(5)
+    len <- 240 # should be mod 4 for building the xreg
+    expect_true(len %% 4 == 0)
+    ts <- ts(arima.sim(n = len, list(ar = c(0.8, -0.2), ma = c(-0.2, 0.8)), sd = 1), f = 3)
+    xreg = as.matrix(data.frame(x1 = rep_len(0:1, len), x2 = rep_len(0:4, len)))
+    ts <- ts + xreg[, "x1"] + xreg[, "x2"]
+    # Ensure we have enough data to differentiate the benefits of adding xreg
+    aa <- auto.arima(ts)
+    aa_xreg <- auto.arima(ts, xreg = xreg)
+    expect_true(AIC(aa_xreg) < AIC(aa))
+    trainIndices <- 1:len <= len * 0.9
+    trainTestDivide = len * 0.9
+    xregTrain <- xreg[trainIndices, ]
+    xregTest <- xreg[!trainIndices, ]
+    tsTrain <- subset(ts, end = trainTestDivide)
+    tsTest <- subset(ts, start = trainTestDivide + 1)
+    aa <- auto.arima(tsTrain)
+    aa_xreg <- auto.arima(tsTrain, xreg = xregTrain)
+    expect_true(accuracy(forecast(aa_xreg, xreg = xregTrain))[1, "MASE"] <
+                accuracy(forecast(aa))[1, "MASE"])
+    hm <- hybridModel(tsTrain, models = "as", s.args = list(method = "arima"))
+
+    h <- nrow(xregTest)
+    hm_fc <- forecast(hm, h = h)
+    expect_true(length(hm_fc$mean) == h)
+    # Test with several different xregs
+    for(colIndex in list(1, 2, 1:2)){
+        xrTrain <- as.matrix(xregTrain[, colIndex])
+        xrTest <- as.matrix(xregTest[, colIndex])
+        hm_xreg <- hybridModel(tsTrain, models = "as",
+                               a.args = list(xreg = xrTrain),
+                               s.args = list(xreg = xrTrain, method = "arima"))
+        # Base models should work
+        expect_error(forecast(hm_xreg$auto.arima, xreg = xrTest), NA)
+        expect_error(forecast(hm_xreg$stlm, xreg = xrTest), NA)
+        hm_xreg_fc <- forecast(hm_xreg, xreg = xrTest)
+        expect_true(length(hm_fc$mean) == length(hm_xreg_fc$mean))
+        # Model with xreg should be better than model without
+        expect_true(AIC(hm_xreg$auto.arima) < AIC(hm$auto.arima))
+    }
+
+    # single feature xreg should return same results when passed as matrix or numeric
+    len <- h <- 24
+    dat <- ts(runif(len), f = 2)
+    xreg <- rnorm(len)
+    xreg_mat <- matrix(xreg)
+    hm_mat <- hybridModel(dat, "as", a.args = list(xreg = xreg_mat),
+                          s.args = list(xreg = xreg_mat, method = "arima"))
+    mat_fc <- forecast(hm_mat, h = h, xreg = xreg_mat)
+    fc <- forecast(hm_mat, h = h, xreg = xreg)
+    # Forecasts where the new xreg is a matrix or numeric should match
+    expect_true(all.equal(fc$mean, mat_fc$mean))
+
+    # a model trained with a vector xreg should produce the same forecasts when using a matrix xreg
+    hm <- hybridModel(dat, "as", a.args = list(xreg = xreg),
+                  s.args = list(xreg = xreg, method = "arima"))
+    fc <- forecast(hm, h = h, xreg = xreg)
+    expect_true(all.equal(fc$mean, mat_fc$mean))
+    mat_fc <- forecast(hm, xreg = xreg_mat)
+    expect_true(all.equal(fc$mean, mat_fc$mean))
   })
 }

pkg/tests/testthat/test-hybridModel.R

@@ -4,14 +4,16 @@ if(require(forecast) & require(testthat)){
   test_that("Testing invalid inputs", {
     # Invalid arguments for models
     expect_error(hybridModel(y = 1:10, models = "jten"))
+    expect_error(hybridModel(y = 1:10, models = "ae32"))
+    expect_error(hybridModel(y = 1:10, models = "32"))
+    expect_error(hybridModel(y = 1:10, models = ""))
     # models must be characters
     expect_error(hybridModel(y = 1:10, models = 5))
     expect_error(hybridModel(y = matrix(1:10, nrow = 5, ncol = 2),
                              models = 5))
     # Test for invalid mismatch length of y and xreg in a.args/s.args later?
-    badxreg <- data.frame(rnorm(length(wineind) - 1))
-    expect_warning(expect_error(hybridModel(y = wineind,
-                                            a.args = list(xreg = badxreg))))
+    badxreg <- rnorm(length(wineind) - 1)
+    expect_warning(expect_error(hybridModel(y = wineind, a.args = list(xreg = badxreg))))
     # More invalid inputs
     expect_error(hybridModel(y = "hello world"))
     # must provide input series
@@ -109,13 +111,15 @@ if(require(forecast) & require(testthat)){
 
   test_that("Testing the hybridModel object", {
     modelComparison <- list()
-    for(parallel in c(TRUE, FALSE)){
+    for(parallel in c(FALSE, TRUE)){
       set.seed(4)
-      len <- 10
+      len <- 20
       freq <- 2
       tol <- 10^-8
       testSeries <- ts(rnorm(len), f = freq)
-      xreg <- data.frame(matrix(rnorm(len * 3), nrow = len))
+      cols <- c("a", "b", "c")
+      xreg <- matrix(rnorm(len * length(cols)), nrow = len)
+      colnames(xreg) <- cols
       # Ignore nnetar for now since it isn't reproducible
       models <- "aefstz"
       hm <- hybridModel(testSeries, models = models,
@@ -153,8 +157,11 @@ if(require(forecast) & require(testthat)){
       expect_true("stlm" %in% class(hm$stlm))
       expect_true("forecast" %in% class(hm$snaive))
 
+      # Base forecasts should work
+      expect_error(forecast(hm$auto.arima, xreg = xreg), NA)
       # Test forecast
-      expect_error(forecast(hm, xreg = xreg), NA)
+      h <- nrow(xreg)
+      expect_error(forecast(hm, h = h, xreg = xreg), NA)
       modelComparison[[as.character(parallel)]] <- hm
     }
     # Compare the results from parallel = TRUE and parallel = FALSE

pkg/vignettes/forecastHybrid.Rmd

@@ -165,14 +165,14 @@ hm5$stlm$lambda
 
 Note that lambda has no impact on ```thetam``` models, and that there is no ```f.args``` argument to provide parguments to ```thetam```.  Following ```forecast::thetaf``` on which ```thetam``` is based, there are no such arguments; it always runs with the defaults.
 
-Covariates can also be supplied to ```auto.arima``` and ```nnetar``` models as is done in the "forecast" package. To do this, utilize the ```a.args``` and ```n.args``` lists. Note that the ```xreg``` may also be passed to a ```stlm``` model, but only when ```method = "arima"``` instead of the default ```method = "ets"```. Unlike the usage in the "forecast" package, the ```xreg``` argument should be passed as a dataframe, not a matrix. The ```stlm``` models require that the input series will be seasonal, so in the example below we will convert the input data to a ```ts``` object. If a ```xreg``` is used in training, it must also be supplied to the ```forecast()``` function in the ```xreg``` argument. Note that if the number of rows in the ```xreg``` to be used for the forecast does not match the supplied ```h``` forecast horizon, the function will overwrite ```h``` with the number of rows in ```xreg``` and issue a warning.
+Covariates can also be supplied to ```auto.arima``` and ```nnetar``` models as is done in the "forecast" package. To do this, utilize the ```a.args``` and ```n.args``` lists. Note that the ```xreg``` may also be passed to a ```stlm``` model, but only when ```method = "arima"``` instead of the default ```method = "ets"```. Unlike the usage in the "forecast" package, the ```xreg``` argument should be passed as a matrix, not a dataframe. The ```stlm``` models require that the input series will be seasonal, so in the example below we will convert the input data to a ```ts``` object. If a ```xreg``` is used in training, it must also be supplied to the ```forecast()``` function in the ```xreg``` argument. Note that if the number of rows in the ```xreg``` to be used for the forecast does not match the supplied ```h``` forecast horizon, the function will overwrite ```h``` with the number of rows in ```xreg``` and issue a warning.
 ```{r xreg, cache = TRUE}
 # Use the beaver1 dataset with the variable "activ" as a covariate and "temp" as the timeseries
 # Divice this into a train and test set
 trainSet <- beaver1[1:100, ] 
 testSet <- beaver1[-(1:100), ]
-trainXreg <- data.frame(trainSet$activ)
-testXreg <- data.frame(testSet$activ)
+trainXreg <- matrix(trainSet$activ)
+testXreg <- matrix(testSet$activ)
 
 # Create the model
 beaverhm <- hybridModel(ts(trainSet$temp, f = 6),