tests/testthat/test-hybridModel.R

In forecastHybrid: Convenient Functions for Ensemble Time Series Forecasts

# Unit tests on the hybridModel function
if (require(forecast) & require(testthat)) {
  context("Testing input for hybridModel()")
  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 <- 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
    expect_error(hybridModel())
    # input series must have data
    expect_error(hybridModel(y = numeric()))
    # input series must be numeric
    expect_error(hybridModel(y = "aten"))
    # models must be one of a, e, f, t, n, s, z
    expect_error(hybridModel(y = wineind, models = "abcderfghijk"))
    # ensemble must have at least two models
    expect_error(hybridModel(wineind, models = "a"))
    # num.core must be positive
    expect_error(hybridModel(wineind, num.cores = -1L))
    # num.cores must be an integer
    expect_error(hybridModel(wineind, num.cores = 3.3))
    # num.cores must be numeric
    expect_error(hybridModel(wineind, num.cores = "a"))
    # models must not be empty string
    expect_error(hybridModel(wineind, models = ""))
    # parallel should be a boolean
    expect_error(hybridModel(wineind, parallel = "a"))
  })

  test_that("Testing for warnings", {
    # hybridModel creates a warning when an arg list for an unused model is passed
    expect_warning(hybridModel(wineind, models = "fs", a.args = list()))
    expect_warning(hybridModel(wineind, models = "fs", e.args = list()))
    expect_warning(hybridModel(wineind, models = "fs", n.args = list()))
    expect_warning(hybridModel(wineind, models = "fn", s.args = list()))
    expect_warning(hybridModel(wineind, models = "fs", t.args = list()))
    # thetam() requires at least one seasonal period of data
    expect_warning(hybridModel(ts(rnorm(4), f = 7), models = "aef"))
    # ts is too short: nnetar() and stlm() with 2 * frequency(y) >= length(y)
    inputSeries <- ts(rnorm(8), f = 4)
    expect_warning(hybridModel(inputSeries, models = "aesn"))
    # ts is too short: stlm() with 2 * frequency(y) >= length(y)
    inputSeries <- ts(rnorm(7), f = 4)
    expect_warning(hybridModel(inputSeries, models = "efs"))
    # ets with frequency(y) > 24
    inputSeries <- ts(rnorm(75), f = 25)
    expect_warning(hybridModel(inputSeries, models = "ens"))
    # weights = "cv.weights" with errorMethod = "MASE" is not yet implemented
    expect_warning(hybridModel(wineind, models = "fs", weights = "cv.errors",
                               errorMethod = "MASE"))
    # weights = "insample.errors" when there is a perfect fit
    expect_warning(hybridModel(ts(1:20, f = 2), weight = "insample.errors"))
  })

  test_that("Testing valid inputs", {
    set.seed(54321)
    expect_error(hybridModel(wineind, models = "an", f.args = list()))
    expect_error(hybridModel(y = rnorm(10), models = "ae",
                             a.args = list(xreg = matrix(runif(10), nrow = 10))), NA)
    expect_warning(hybridModel(y = rnorm(10), models = "en",
                               a.args = list(lambda = 0.5)))
    inputSeries <- ts(rnorm(9), f = 4)
    expect_warning(hybridModel(inputSeries, models = "aensft",
                               weights = "insample.errors"))
    # soft deprecated insample.errors
    expect_warning(hybridModel(wineind, models = "fs",
                               weights = "insample.errors"))
    expect_error(hybridModel(inputSeries, models = "ae",
                             e.args = list(lambda = 0.5)), NA)
    # test parallel
    inputSeries <- ts(rnorm(8), f = 2)
    expect_warning(hybridModel(inputSeries, models = "fs", parallel = TRUE), NA)
    expect_warning(hybridModel(inputSeries, models = "fs", parallel = TRUE,
                               num.cores = 2), NA)
  })

  test_that("Testing long data", {
    set.seed(42)
    dat <- ts(rnorm(52 * 3), f = 52)
    expect_warning(hm <- hybridModel(y = dat, models = "fs"), NA)
    expect_true(length(forecast(hm)$mean) == 52 * 2)
    # Test for messy function call
    hm <- hybridModel(wineind)
    # Disable these for now because fails on r-devel
    # Less than orignal, messy function call
    # works on ARM, not AMD64 expect_true(format(object.size(hm)) <= "6035456 bytes")
    # No worse than improved function call
    # previously tested withexpect_true(format(object.size(hm)) <= "322352 bytes")
  })

  test_that("Testing model matching", {
    set.seed(123456)
    expect_error(hybridModel(y = rnorm(20), models = "AAAAE"), NA)
    expect_error(hybridModel(y = rnorm(20), models = "AtTaaa"), NA)
    expect_error(hybridModel(y = rnorm(20), models = "nNeTEEEeA"), NA)
  })

  context("Testing cv.errors")
  test_that("Testing hybridModel(weights = \"cv.errors\")", {
  set.seed(33)
  inputSeries <- ts(rnorm(12), f = 2)
  expect_error(cvMod <- hybridModel(inputSeries, weights = "cv.errors",
                                    windowSize = 8, cvHorizon = 2), NA)
  expect_equal(length(cvMod$weights),
               length(unique(cvMod$weights)))
  })

  test_that("Testing the hybridModel object", {
    modelComparison <- list()
    for (parallel in c(FALSE, TRUE)) {
      set.seed(4)
      len <- 20
      freq <- 2
      tol <- 10^-8
      testSeries <- ts(rnorm(len), f = freq)
      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
      # TODO: add nnetar to xreg tests
      models <- "aefstz"
      hm <- hybridModel(testSeries, models = models,
                        a.args = list(xreg = xreg), lambda = 0.2,
                        parallel = parallel)
      for (obj in hm) {
        expect_true(all(class(obj) != "NULL"))
        expect_true(!is.null(obj))
      }
      # Ensure numeric values
      expect_true(is.numeric(hm$fitted))
      expect_true(is.numeric(hm$residuals))
      expect_true(is.numeric(hm$x))
      expect_true(length(hm$fitted) == length(testSeries))
      expect_true(length(hm$residuals) == length(testSeries))
      expect_true(length(hm$x) == length(testSeries))
      expect_true(all(hm$weights >= 0))
      # Weights should sum to 1 but allow tolerance
      expect_true(sum(hm$weights) - 1 < tol)
      expect_true(length(hm$weights) == nchar(models))
      expect_true(hm$frequency == freq)
      # Ensure xreg is correct
      expect_true(all(hm$auto.arima$xreg == xreg))
      expect_true(hm$xreg$auto.arima)
      expect_true(!hm$xreg$stlm)
      # Ensure other fields are correct
      expect_true(length(hm$models) == nchar(models))
      expect_true(all(names(hm$weights) == hm$models))
      # Ensure the models are of the expected classes
      expect_true("ARIMA" %in% class(hm$auto.arima))
      expect_true("ets" == class(hm$ets))
      expect_true("thetam" %in% class(hm$thetam))
      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
      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
    tol <- 10^-8
    parallelFitted <- modelComparison[["TRUE"]]$fitted
    serialFitted <- modelComparison[["FALSE"]]$fitted
    expect_true(sum(abs(parallelFitted - serialFitted), na.rm = TRUE) < tol)
    expect_true(all(is.na(serialFitted) == is.na(parallelFitted)))

    parallelResiduals <- modelComparison[["TRUE"]]$residuals
    serialResiduals <- modelComparison[["FALSE"]]$residuals
    expect_true(sum(abs(parallelResiduals - serialResiduals), na.rm = TRUE) < tol)
    expect_true(all(is.na(serialResiduals) == is.na(parallelResiduals)))
  })

  test_that("Testing the weighting methods", {
    inputSeries <- ts(rnorm(100), f = 2)
    tol <- 10^-8
    # Test two quick models since we will be performing cross validation
    models <- "fs"
    weights <- c("equal", "insample.errors", "cv.errors")
    # TODO: add another loop here for errorMethod once MASE with cv.errors is implemented
    results <- list()
    for (weight in weights) {
      if (weight == "insample.errors") {
        expect_warning(hm <- hybridModel(inputSeries, models = models,
                                         weights = weight))
      } else{
        hm <- hybridModel(inputSeries, models = models, weights = weight)
      }
      expect_true(sum(hm$weights) - 1 < tol)
      expect_true(all(hm$weights >= 0))
      expect_true(all(hm$weights <= 1))
      expect_true(length(hm$weights) == nchar(models))
      results[[weight]] <- hm
    }
    # Test that weights are not equal
    weightResults <- sapply(results, function(x) x$weights)
    weights <- as.list(data.frame(weightResults))
    expect_true(all(weights$insample.errors != weights$cv.errors))
    expect_true(all(weights$insample.errors != weights$equal))
    expect_true(all(weights$equal != weights$cv.errors))
  })

  test_that("Testing the hybrid model with xreg", {
    # Test with data from issue #86
    trainSet <- beaver1[1:100, ]
    testSet <- beaver1[- (1:100), ]
    trainXreg <- as.matrix(data.frame(trainSet$activ, trainSet$time))
    beaverhm <- hybridModel(ts(trainSet$temp, f = 6),
                            models = "aenst",
                            a.args = list(xreg = trainXreg),
                            n.args = list(xreg = trainXreg),
                            s.args = list(xreg = trainXreg, method = "arima"))
    expect_true(all.equal(names(beaverhm$xreg), c("auto.arima", "nnetar", "stlm")))
    expect_true(all(beaverhm$xreg == TRUE))
  })
}