tests/testthat/test-make_future.R

In tscv: Functions and Utilities for Tidy Time Series Forecasting and Time Series Cross-Validation

test_that("make_future converts a fable to a future frame", {
  skip_if_not_installed("dplyr")
  skip_if_not_installed("tsibble")
  skip_if_not_installed("fable")
  skip_if_not_installed("fabletools")

  library(dplyr)
  library(tsibble)
  library(fable)
  library(fabletools)

  context <- list(
    series_id = "series",
    value_id = "value",
    index_id = "index"
  )

  main_frame <- M4_monthly_data |>
    filter(series %in% c("M23100", "M14395"))

  split_frame <- make_split(
    main_frame = main_frame,
    context = context,
    type = "first",
    value = 120,
    n_ahead = 18,
    n_skip = 17,
    n_lag = 0,
    mode = "stretch",
    exceed = FALSE
  )

  train_frame <- slice_train(
    main_frame = main_frame,
    split_frame = split_frame,
    context = context
  ) |>
    as_tsibble(
      index = index,
      key = c(series, split)
    )

  model_frame <- train_frame |>
    model(
      "SNAIVE" = SNAIVE(value ~ lag("year"))
    )

  fable_frame <- model_frame |>
    forecast(h = 18)

  future_frame <- make_future(
    fable = fable_frame,
    context = context
  )

  expect_s3_class(future_frame, "tbl_df")

  expect_true(all(
    c("index", "series", "model", "split", "horizon", "point") %in%
      names(future_frame)
  ))

  expect_equal(names(future_frame)[1:6], c(
    "index", "series", "model", "split", "horizon", "point"
  ))

  expect_equal(unique(future_frame$model), "SNAIVE")
  expect_equal(sort(unique(future_frame$series)), c("M14395", "M23100"))
  expect_equal(sort(unique(future_frame$horizon)), 1:18)

  expect_true(is.numeric(future_frame$point))
  expect_true(all(is.finite(future_frame$point)))
})


test_that("make_future returns one row per forecast horizon, series, split, and model", {
  skip_if_not_installed("dplyr")
  skip_if_not_installed("tsibble")
  skip_if_not_installed("fable")
  skip_if_not_installed("fabletools")

  library(dplyr)
  library(tsibble)
  library(fable)
  library(fabletools)

  context <- list(
    series_id = "series",
    value_id = "value",
    index_id = "index"
  )

  main_frame <- M4_monthly_data |>
    filter(series %in% c("M23100", "M14395"))

  split_frame <- make_split(
    main_frame = main_frame,
    context = context,
    type = "first",
    value = 120,
    n_ahead = 18,
    n_skip = 17,
    n_lag = 0,
    mode = "stretch",
    exceed = FALSE
  )

  train_frame <- slice_train(
    main_frame = main_frame,
    split_frame = split_frame,
    context = context
  ) |>
    as_tsibble(
      index = index,
      key = c(series, split)
    )

  model_frame <- train_frame |>
    model(
      "SNAIVE" = SNAIVE(value ~ lag("year"))
    )

  fable_frame <- model_frame |>
    forecast(h = 18)

  future_frame <- make_future(
    fable = fable_frame,
    context = context
  )

  expected_rows <- fable_frame |>
    as_tibble() |>
    nrow()

  expect_equal(nrow(future_frame), expected_rows)

  rows_per_group <- future_frame |>
    count(series, model, split)

  expect_true(all(rows_per_group$n == 18))
})


test_that("make_future works with multiple models", {
  skip_if_not_installed("dplyr")
  skip_if_not_installed("tsibble")
  skip_if_not_installed("fable")
  skip_if_not_installed("fabletools")

  library(dplyr)
  library(tsibble)
  library(fable)
  library(fabletools)

  context <- list(
    series_id = "series",
    value_id = "value",
    index_id = "index"
  )

  main_frame <- M4_monthly_data |>
    filter(series %in% c("M23100", "M14395"))

  split_frame <- make_split(
    main_frame = main_frame,
    context = context,
    type = "first",
    value = 120,
    n_ahead = 18,
    n_skip = 17,
    n_lag = 0,
    mode = "stretch",
    exceed = FALSE
  )

  train_frame <- slice_train(
    main_frame = main_frame,
    split_frame = split_frame,
    context = context
  ) |>
    as_tsibble(
      index = index,
      key = c(series, split)
    )

  model_frame <- train_frame |>
    model(
      "SNAIVE" = SNAIVE(value ~ lag("year")),
      "MEAN" = MEAN(value)
    )

  fable_frame <- model_frame |>
    forecast(h = 18)

  future_frame <- make_future(
    fable = fable_frame,
    context = context
  )

  expect_s3_class(future_frame, "tbl_df")
  expect_equal(sort(unique(future_frame$model)), c("MEAN", "SNAIVE"))

  rows_per_group <- future_frame |>
    count(series, model, split)

  expect_true(all(rows_per_group$n == 18))
})


test_that("make_future creates horizon within each forecast group", {
  skip_if_not_installed("dplyr")
  skip_if_not_installed("tsibble")
  skip_if_not_installed("fable")
  skip_if_not_installed("fabletools")

  library(dplyr)
  library(tsibble)
  library(fable)
  library(fabletools)

  context <- list(
    series_id = "series",
    value_id = "value",
    index_id = "index"
  )

  main_frame <- M4_monthly_data |>
    filter(series %in% c("M23100", "M14395"))

  split_frame <- make_split(
    main_frame = main_frame,
    context = context,
    type = "first",
    value = 120,
    n_ahead = 18,
    n_skip = 17,
    n_lag = 0,
    mode = "stretch",
    exceed = FALSE
  )

  train_frame <- slice_train(
    main_frame = main_frame,
    split_frame = split_frame,
    context = context
  ) |>
    as_tsibble(
      index = index,
      key = c(series, split)
    )

  model_frame <- train_frame |>
    model(
      "SNAIVE" = SNAIVE(value ~ lag("year"))
    )

  fable_frame <- model_frame |>
    forecast(h = 18)

  future_frame <- make_future(
    fable = fable_frame,
    context = context
  )

  horizon_check <- future_frame |>
    group_by(series, model, split) |>
    summarise(
      first_horizon = first(horizon),
      last_horizon = last(horizon),
      n_horizons = n_distinct(horizon),
      .groups = "drop"
    )

  expect_true(all(horizon_check$first_horizon == 1))
  expect_true(all(horizon_check$last_horizon == 18))
  expect_true(all(horizon_check$n_horizons == 18))
})


test_that("make_future point forecasts match the fable mean forecasts", {
  skip_if_not_installed("dplyr")
  skip_if_not_installed("tsibble")
  skip_if_not_installed("fable")
  skip_if_not_installed("fabletools")

  library(dplyr)
  library(tsibble)
  library(fable)
  library(fabletools)

  context <- list(
    series_id = "series",
    value_id = "value",
    index_id = "index"
  )

  main_frame <- M4_monthly_data |>
    filter(series %in% c("M23100", "M14395"))

  split_frame <- make_split(
    main_frame = main_frame,
    context = context,
    type = "first",
    value = 120,
    n_ahead = 18,
    n_skip = 17,
    n_lag = 0,
    mode = "stretch",
    exceed = FALSE
  )

  train_frame <- slice_train(
    main_frame = main_frame,
    split_frame = split_frame,
    context = context
  ) |>
    as_tsibble(
      index = index,
      key = c(series, split)
    )

  model_frame <- train_frame |>
    model(
      "SNAIVE" = SNAIVE(value ~ lag("year"))
    )

  fable_frame <- model_frame |>
    forecast(h = 18)

  future_frame <- make_future(
    fable = fable_frame,
    context = context
  )

  fable_mean <- fable_frame |>
    as_tibble() |>
    transmute(
      index = index,
      series = series,
      model = .model,
      split = split,
      point = .mean
    )

  future_points <- future_frame |>
    select(index, series, model, split, point)

  expect_equal(future_points, fable_mean)
})