tests/testthat/test-rw.R

In tidyverts/fable: Forecasting Models for Tidy Time Series

context("test-rw.R")
test_that("NAIVE", {
  skip_if_not_installed("forecast")
  fable_fit <- USAccDeaths_tbl %>% model(naive = NAIVE(value))
  forecast_fc <- forecast::naive(USAccDeaths, h = 12)

  expect_equivalent(
    fitted(fable_fit)[[".fitted"]],
    unclass(fitted(forecast_fc))
  )

  fable_fc <- fable_fit %>% forecast(h = 12)

  expect_equivalent(
    fc_mean(fable_fc$value),
    unclass(forecast_fc$mean)
  )
  expect_identical(
    model_sum(fable_fit$naive[[1]]),
    "NAIVE"
  )
})

test_that("RW w/ drift", {
  skip_if_not_installed("forecast")
  fable_fit <- USAccDeaths_tbl %>% model(rw = RW(value ~ drift()))
  forecast_fc <- forecast::rwf(USAccDeaths, drift = TRUE, h = 12)

  expect_equivalent(
    fitted(fable_fit)[[".fitted"]],
    unclass(fitted(forecast_fc))
  )

  fable_fc <- fable_fit %>% forecast(h = 12)

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

  if(packageVersion("forecast") > "8.17.0"){
    expect_equivalent(
      unclass(hilo(fable_fc)$`80%`)$upper,
      unclass(forecast_fc$upper[, 1])
    )
  }

  expect_identical(
    model_sum(fable_fit$rw[[1]]),
    "RW w/ drift"
  )

  expect_output(
    report(fable_fit),
    "Drift: 3\\.2817 \\(se: 87\\.2696\\)"
  )

  expect_equal(
    tidy(fable_fit)$estimate,
    forecast_fc$model$par$drift
  )

  expect_equal(
    glance(fable_fit)$sigma2,
    forecast_fc$model$sigma2
  )

  expect_equivalent(
    residuals(fable_fit)[[".resid"]],
    unclass(residuals(forecast_fc))
  )
})

test_that("SNAIVE", {
  skip_if_not_installed("forecast")
  fable_fit <- USAccDeaths_tbl %>% model(snaive = SNAIVE(value))
  forecast_fc <- forecast::snaive(USAccDeaths, h = 12)

  expect_equivalent(
    fitted(fable_fit)[[".fitted"]],
    unclass(fitted(forecast_fc))
  )

  fable_fc <- fable_fit %>% forecast(h = 12)

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

  expect_identical(
    model_sum(fable_fit$snaive[[1]]),
    "SNAIVE"
  )

  fable_fc_sim <- fable_fit %>%
    forecast(h = 12, bootstrap = TRUE, times = 5)
  # expect_equal(
  #   fable_fc$value,
  #   fable_fc_sim$value
  # )

  skip_if_not_installed("tsibbledata")
  expect_warning(
    tsibbledata::vic_elec %>%
      tsibble::index_by(date = as.Date(Time)) %>%
      dplyr::summarise(demand = mean(Demand)) %>%
      model(SNAIVE(demand ~ lag("year"))),
    "Non-integer lag orders for random walk models are not supported"
  )
})

test_that("RW short", {
  library(tsibble)
  fc <- suppressWarnings(tsibble(year = 2010:2012, y = 1:3, index = year) %>%
    model(SNAIVE(y ~ lag(4))) %>%
    forecast(h = 4))

  expect_equal(
    fc_mean(fc$y),
    c(NA, 1, 2, 3)
  )
})

test_that("lagwalk with bad inputs", {
  expect_warning(
    UKLungDeaths %>%
      model(SNAIVE(vars(mdeaths, fdeaths))),
    "Only univariate responses are supported by lagwalks"
  )

  expect_warning(
    UKLungDeaths %>%
      model(SNAIVE(resp(rlang::rep_along(mdeaths, NA)))),
    "All observations are missing"
  )

  expect_warning(
    UKLungDeaths %>%
      model(SNAIVE(mdeaths ~ lag(1))),
    "Non-seasonal model specification provided"
  )
})