tests/testthat/test-ets.R

In fable: Forecasting Models for Tidy Time Series

context("test-ets.R")

forecast_fit <- USAccDeaths %>% forecast::ets()
test_that("Automatic ETS selection", {
  # Automatic model selection
  fable_fit <- USAccDeaths_tbl %>% model(ets = ETS(value))

  expect_equivalent(
    tidy(fable_fit$ets[[1]]$fit)$estimate,
    c(coef(forecast_fit), -sum(coef(forecast_fit)[-(1:3)]))
  )

  # Short series
  expect_equal(
    tidy(model(UKLungDeaths[1:24, ], ETS(mdeaths)))$estimate,
    c(1, 2134),
    tolerance = 0.5
  )
})

test_that("Manual ETS selection", {
  # Manual model selection
  fable_fit <- USAccDeaths_tbl %>% model(ets = ETS(value ~ error("A") + trend("N") + season("A")))

  expect_equivalent(
    tidy(fable_fit$ets[[1]]$fit)$estimate,
    c(coef(forecast_fit), -sum(coef(forecast_fit)[-(1:3)]))
  )

  expect_identical(
    model_sum(fable_fit$ets[[1]]),
    "ETS(A,N,A)"
  )

  fable_fc <- fable_fit %>% forecast()
  forecast_fc <- forecast_fit %>% forecast::forecast()

  expect_equivalent(
    fc_mean(fable_fc$value),
    unclass(forecast_fc$mean)
  )

  # Test simulation
  fable_fit %>%
    generate(USAccDeaths_tbl)
  fable_fit %>%
    generate(USAccDeaths_tbl %>%
      dplyr::mutate(index = index + 72))

  # Test refit
  expect_identical(
    tidy(refit(fable_fit, USAccDeaths_tbl))$estimate == tidy(fable_fit)$estimate,
    c(rep(TRUE, 2), rep(FALSE, 13))
  )
  expect_identical(
    tidy(refit(fable_fit, USAccDeaths_tbl, reinitialise = FALSE))$estimate,
    tidy(fable_fit)$estimate
  )

  # Test components
  cmp <- components(fable_fit)
  expect_identical(
    tidy(fable_fit)$estimate[3:14],
    c(cmp$level[12], cmp$season[12:2])
  )
  expect_s3_class(
    cmp, "dcmp_ts"
  )

  # Test report
  expect_output(
    report(fable_fit),
    "sigma\\^2:  85667.86"
  )

  aug <- augment(fable_fit)
  expect_equal(
    aug$value,
    aug$.fitted + aug$.resid
  )

  # Test specification of smoothing params
  coef <- USAccDeaths_tbl %>%
    model(ETS(value ~ error("A") + season("A", gamma = 0.0001) +
      trend("Ad", alpha = 0.5, beta = 0.006, phi = 0.975))) %>%
    tidy()
  expect_identical(
    coef$estimate[1:4],
    c(0.5, 0.006, 0.0001, 0.975)
  )
  expect_identical(
    coef$term,
    c("alpha", "beta", "gamma", "phi", "l[0]", "b[0]", sprintf("s[%i]", 0:-11))
  )
})


test_that("ETS with bad inputs", {
  # Test for multiple specials defined
  expect_warning(
    USAccDeaths_tbl %>% model(ETS(value ~ error("A") + error("A"))),
    "Only one special of each type is allowed for ETS"
  )

  expect_warning(
    USAccDeaths_tbl %>% model(ETS(value ~ trend(alpha = 1.5))),
    "Inconsistent parameter boundaries"
  )

  expect_warning(
    USAccDeaths_tbl %>% model(ETS(value ~ error("A") + trend("A", alpha = 0.2, beta = 0.5) + season("N"))),
    "Parameters out of range"
  )

  expect_warning(
    UKLungDeaths %>%
      model(ETS(vars(mdeaths, fdeaths))),
    "Only univariate responses are supported by ETS"
  )

  UK_missing <- UKLungDeaths
  UK_missing[["mdeaths"]][3:5] <- NA
  expect_warning(
    UK_missing %>%
      model(ETS(mdeaths)),
    "ETS does not support missing values"
  )

  expect_warning(
    UKLungDeaths %>%
      model(ETS(mdeaths ~ trend("M") + season("A"))),
    "No valid ETS models have been allowed"
  )

  expect_warning(
    UKLungDeaths[1:2, ] %>%
      model(ETS(mdeaths)),
    "Not enough data to estimate this ETS model"
  )
})


test_that("Multiplicative ETS models", {
  fable_fit <- USAccDeaths_tbl %>%
    model(ets = ETS(value ~ error("M") + trend("N") + season("N")))
  expect_true(
    is.constant(fc_mean(forecast(fable_fit)$value))
  )

  expect_s3_class(
    USAccDeaths_tbl %>%
      model(ets = ETS(value ~ error("M") + trend("A") + season("M"))) %>%
      forecast(),
    "fbl_ts"
  )


  expect_s3_class(
    USAccDeaths_tbl %>%
      model(ets = ETS(value ~ error("M") + trend("M") + season("M"))) %>%
      forecast(times = 5),
    "fbl_ts"
  )
})