tests/testthat/test-main.R

In temper: Temporal Encoder-Masked Probabilistic Ensemble Regressor

# tests/testthat/test-temper.R
library(testthat)
library(temper)

set.seed(42)

## 1 ─ Structure --------------------------------------------------------------
test_that("temper returns all expected components", {
  skip_on_cran()
  skip_if_not_installed("torch")

  torch_manual_seed(666)
  torch_set_num_threads(1)

  fit <- temper(
    ts         = dummy_set$MSFT.Close,
    future     = 2,
    past       = 3,
    latent_dim = 2,
    n_trees    = 30,
    depth      = 4,
    epochs     = 1,           # keeps runtime tiny
    train_rate = 0.5,
    verbose    = FALSE,
    seed = 12
  )

  expect_type(fit, "list")
  expect_named(fit,
               c("loss", "pred_funs", "plot", "time_log"),
               ignore.order = TRUE)

  expect_length(fit$pred_funs, 2)
  expect_identical(class(fit$plot), c("gg", "ggplot"))
  expect_identical(class(fit$time_log)[1], "Period")
})

## 2 ─ Reproducibility --------------------------------------------------------
test_that("temper is deterministic given the same seed", {
  skip_on_cran()
  skip_if_not_installed("torch")

  torch_manual_seed(666)
  torch_set_num_threads(1)

  fit1 <- temper(ts = dummy_set$TSLA.Close, future = 3, past = 10,
                 latent_dim = 2, n_trees = 30, depth = 4, optimizer = "adagrad",
                 epochs = 1, seed = 12, verbose = FALSE)

  fit2 <- temper(ts = dummy_set$TSLA.Close, future = 3, past = 10,
                 latent_dim = 2, n_trees = 30, depth = 4, optimizer = "adagrad",
                 epochs = 1, seed = 12, verbose = FALSE)

  med1 <- fit1$pred_funs$t3$pfun(0.5)
  med2 <- fit2$pred_funs$t3$pfun(0.5)

  expect_equal(med1, med2, tolerance = 1e-3)
})

## 3 ─ Date handling ----------------------------------------------------------
test_that("temper accepts an explicit Date index", {
  skip_on_cran()
  skip_if_not_installed("torch")

  torch_manual_seed(666)
  torch_set_num_threads(1)

  expect_error(
    temper(ts = dummy_set$MARA.Close, future = 2, past = 10,
           latent_dim = 2, n_trees = 30, depth = 4, optimizer = "rprop",
           epochs = 1, dates = dummy_set$dates, verbose = FALSE, seed = 12),
    regexp = NA                         # i.e. *no* error expected
  )
})