tests/testthat/test-tune_vlmc.R

In mixvlmc: Variable Length Markov Chains with Covariates

test_that("tune_vlmc obeys is basic contract", {
  data_set <- build_markov_chain(1000, 4, seed = 4)
  t_vlmc <- tune_vlmc(data_set$x)
  expect_s3_class(t_vlmc, "tune_vlmc")
  expect_true(all(c("best_model", "criterion", "initial", "results") %in% names(t_vlmc)))
  expect_true(is_vlmc(t_vlmc$best_model))
  expect_true(t_vlmc$criterion == "BIC") ## default value
  expect_true(t_vlmc$initial == "truncated") ## default value
  expect_null(t_vlmc$saved_models)
  expect_s3_class(t_vlmc$results, "data.frame")
})

test_that("tune_vlmc selects the best model", {
  data_set <- build_markov_chain(300, 3, seed = 3)
  bt_vlmc <- tune_vlmc(data_set$x, initial = "specific", criterion = "BIC")
  expect_equal(stats::BIC(logLik(bt_vlmc$best_model, initial = "specific")), min(bt_vlmc$results$BIC))
  at_vlmc <- tune_vlmc(data_set$x, initial = "specific", criterion = "AIC")
  expect_equal(stats::AIC(logLik(at_vlmc$best_model, initial = "specific")), min(at_vlmc$results$AIC))
})

test_that("tune_vlmc memorizes the models it is asked to memorize", {
  data_set <- build_markov_chain(500, 4, seed = 2)
  bt_vlmc <- tune_vlmc(data_set$x, initial = "extended", criterion = "BIC", save = "all")
  expect_equal(length(bt_vlmc$saved_models$all) + 1L, nrow(bt_vlmc$results))
  best_BIC_idx <- which.min(bt_vlmc$results$BIC)
  expect_identical(bt_vlmc$best_model, bt_vlmc$saved_models$all[[best_BIC_idx - 1]])
  ## compare the result table and the models
  quantities <- list(
    "BIC" = \(x) stats::BIC(stats::logLik(x, initial = "extended")),
    "AIC" = \(x) stats::AIC(stats::logLik(x, initial = "extended")),
    "loglikelihood" = \(x) stats::logLik(x, initial = "extended"),
    "depth" = depth,
    "nb_contexts" = context_number
  )
  for (quantity in names(quantities)) {
    all_quant <- c(
      quantities[[quantity]](bt_vlmc$saved_models$initial),
      sapply(bt_vlmc$saved_models$all, quantities[[quantity]])
    )
    expect_equal(all_quant, bt_vlmc$results[[quantity]])
  }
})

test_that("tune_vlmc find a large enough max_depth", {
  for (k in 2:4) {
    data_set <- build_markov_chain(500, k, seed = 3 * k)
    t_vlmc_auto <- tune_vlmc(data_set$x, max_depth = 2)
    t_vlmc <- tune_vlmc(data_set$x, max_depth = 100)
    expect_equal(t_vlmc, t_vlmc_auto)
  }
})

test_that("print works as expected", {
  data_set <- build_markov_chain(500, 3, seed = 0)
  t_vlmc_auto <- tune_vlmc(data_set$x, max_depth = 2)
  expect_snapshot_output(print(t_vlmc_auto))
  t_vlmc_auto <- tune_vlmc(data_set$x,
    max_depth = 2,
    initial = "truncated", criterion = "AIC"
  )
  expect_snapshot_output(print(t_vlmc_auto))
})

test_that("summary works as expected", {
  skip_on_ci()
  skip_on_cran()
  data_set <- build_markov_chain(500, 3, seed = 0)
  t_vlmc_auto <- tune_vlmc(data_set$x, max_depth = 2)
  expect_snapshot_output(print(summary(t_vlmc_auto)))
  t_vlmc_auto <- tune_vlmc(data_set$x,
    max_depth = 2,
    initial = "specific", criterion = "AIC"
  )
  expect_snapshot_output(print(summary(t_vlmc_auto)))
})

test_that("tune_vlmc verbosity is adequate", {
  data_set <- build_markov_chain(500, 3, seed = 0)
  expect_snapshot_output(tune_vlmc(data_set$x, max_depth = 2, verbose = 1))
})

test_that("tune_vlmc initial cutoff/alpha are respected", {
  data_set <- build_markov_chain(500, 3, seed = 0)
  vlmc_cutoff <- tune_vlmc(data_set$x, cutoff_init = 4)
  expect_equal(vlmc_cutoff$results$cutoff[1], 4)
  vlmc_alpha <- tune_vlmc(data_set$x, alpha_init = 0.02)
  expect_equal(vlmc_alpha$results$alpha[1], 0.02)
})