tests/testthat/test-vlmc_metrics.R

In mixvlmc: Variable Length Markov Chains with Covariates

test_that("generate_fake_data works as expected", {
  withr::local_seed(0)
  vals <- c(0L, 1L)
  counts <- matrix(2L + sample(1:5, 20, replace = TRUE), ncol = 2)
  freq <- rowSums(counts)
  counts2 <- counts + matrix(sample(0:2, 20, replace = TRUE), ncol = 2)
  probs <- sweep(counts2, 1, rowSums(counts2), "/")
  fake_data <- generate_fake_data(freq, counts, probs, vals)
  expect_length(fake_data$response, sum(freq))
  expect_length(fake_data$predictor, sum(freq))
  global_freqs <- table(fake_data$response)
  expect_equal(as.numeric(global_freqs), colSums(counts))
})

test_that("metrics.vlmc obey its contract", {
  pc <- powerconsumption[powerconsumption$week == 5, ]
  dts <- cut(pc$active_power, breaks = c(0, quantile(pc$active_power, probs = c(0.25, 0.5, 0.75, 1))))
  model <- vlmc(dts, alpha = 0.1)
  m_metrics <- metrics(model)
  ## class
  expect_s3_class(m_metrics, "metrics.vlmc")
  ## names
  expect_true(all(c("accuracy", "conf_mat", "auc") %in% names(m_metrics)))
  ## confusion matrix
  expect_true(inherits(m_metrics$conf_mat, "table"))
  expect_equal(dim(m_metrics$conf_mat), c(length(states(model)), length(states(model))))
  expect_equal(colnames(m_metrics$conf_mat), as.character(states(model)))
  expect_equal(rownames(m_metrics$conf_mat), as.character(states(model)))
  expect_lte(sum(m_metrics$conf_mat), length(dts))
  expect_true(all(colSums(m_metrics$conf_mat) <= table(dts)))
})

test_that("metrics.vlmc objects print as expected", {
  pc <- powerconsumption[powerconsumption$week == 5, ]
  dts <- cut(pc$active_power, breaks = c(0, quantile(pc$active_power, probs = c(0.25, 0.5, 0.75, 1))))
  model <- vlmc(dts, alpha = 0.1)
  m_metrics <- metrics(model)
  expect_snapshot(print(m_metrics))
})

test_that("metrics.vlmc and predict.vlmc return consistent results", {
  pc <- powerconsumption[powerconsumption$week == 5, ]
  dts <- cut(pc$active_power, breaks = c(0, quantile(pc$active_power, probs = c(0.25, 0.5, 0.75, 1))))
  model <- vlmc(dts, alpha = 0.1)
  m_metrics <- metrics(model)
  m_predict <- predict(model, dts, final_pred = FALSE)
  predict_table <- table(m_predict, dts)
  names(dimnames(predict_table)) <- c("predicted value", "true value")
  expect_identical(m_metrics$conf_mat, predict_table)
  for (k in 2:4) {
    data_set <- build_markov_chain(500, k, seed = 3 * k)
    model <- vlmc(data_set$x, alpha = 0.5)
    m_metrics <- metrics(model)
    m_predict <- predict(model, data_set$x, final_pred = FALSE)
    predict_table <- table(m_predict, data_set$x)
    names(dimnames(predict_table)) <- c("predicted value", "true value")
    expect_identical(m_metrics$conf_mat, predict_table)
  }
})

test_that("metrics.vlmc works on real world data", {
  sun_activity <- as.factor(ifelse(sunspot.year >= median(sunspot.year), "high", "low"))
  sun_model_tune <- tune_vlmc(sun_activity)
  expect_no_error(metrics(as_vlmc(sun_model_tune)))
})