tests/testthat/test-covlmc_likelihood.R

In mixvlmc: Variable Length Markov Chains with Covariates

test_that("loglikelihood computes the expected values", {
  withr::local_seed(0)
  x <- sample(c("A", "B", "C"), 1000, replace = TRUE)
  y <- ifelse(runif(length(x)) > 0.5, c(x[-1], sample(c("A", "B", "C"), 1)), c(x[-c(1, 2)], sample(c("A", "B", "C"), 2, replace = TRUE)))
  y <- as.factor(ifelse(runif(length(x)) > 0.2, y, sample(c("A", "B", "C"), 1000, replace = TRUE)))
  df_y <- data.frame(y = y)
  for (engine in c("glm", "multinom")) {
    withr::local_options(mixvlmc.predictive = engine)
    x_covlmc <- covlmc(x, df_y, min_size = 5, alpha = 0.01)
    for (initial in c("truncated", "specific", "extended")) {
      fll <- loglikelihood(x_covlmc, initial = initial, newdata = x, newcov = df_y)
      sll <- co_slow_loglikelihood(x_covlmc, x, initial = initial, newcov = df_y)
      dll <- loglikelihood(x_covlmc, initial = initial)
      expect_equal(as.numeric(fll), as.numeric(sll))
      expect_equal(attr(fll, "df"), attr(sll, "df"))
      expect_equal(attr(fll, "nobs"), attr(sll, "nobs"))
      expect_equal(as.numeric(dll), as.numeric(sll))
      expect_equal(attr(dll, "df"), attr(sll, "df"))
      expect_equal(attr(dll, "nobs"), attr(sll, "nobs"))
    }
  }
})

test_that("loglikelihood computes the expected values with ignore", {
  withr::local_seed(42)
  x <- sample(c("A", "B", "C"), 1000, replace = TRUE)
  y <- ifelse(runif(length(x)) > 0.5, c(x[-1], sample(c("A", "B", "C"), 1)), c(x[-c(1, 2)], sample(c("A", "B", "C"), 2, replace = TRUE)))
  y <- as.factor(ifelse(runif(length(x)) > 0.2, y, sample(c("A", "B", "C"), 1000, replace = TRUE)))
  df_y <- data.frame(y = y)
  for (engine in c("glm", "multinom")) {
    withr::local_options(mixvlmc.predictive = engine)
    x_covlmc <- covlmc(x, df_y, min_size = 5, alpha = 0.01)
    for (initial in c("truncated", "specific", "extended")) {
      to_ignore <- depth(x_covlmc) + sample(1:50, 1)
      fll <- loglikelihood(x_covlmc, initial = initial, newdata = x, newcov = df_y, ignore = to_ignore)
      sll <- co_slow_loglikelihood(x_covlmc, x, initial = initial, newcov = df_y, ignore = to_ignore)
      expect_equal(as.numeric(fll), as.numeric(sll))
      expect_equal(attr(fll, "df"), attr(sll, "df"))
      expect_equal(attr(fll, "nobs"), attr(sll, "nobs"))
    }
  }
})

test_that("the likelihood calculation is valid", {
  withr::local_seed(0)
  x <- sample(c("A", "B", "C"), 1000, replace = TRUE)
  y <- ifelse(runif(length(x)) > 0.5, c(x[-1], sample(c("A", "B", "C"), 1)), c(x[-c(1, 2)], sample(c("A", "B", "C"), 2, replace = TRUE)))
  y <- as.factor(ifelse(runif(length(x)) > 0.2, y, sample(c("A", "B", "C"), 1000, replace = TRUE)))
  df_y <- data.frame(y = y)
  for (engine in c("glm", "multinom")) {
    withr::local_options(mixvlmc.predictive = engine)
    x_covlmc <- covlmc(x, df_y, min_size = 5, alpha = 0.01)
    for (initial in c("truncated", "specific", "extended")) {
      expect_equal(
        as.numeric(logLik(x_covlmc, initial = initial)),
        as.numeric(loglikelihood(x_covlmc, initial = initial))
      )
      expect_equal(
        loglikelihood(x_covlmc, initial = initial, newdata = x, newcov = df_y),
        loglikelihood(x_covlmc, initial = initial)
      )
    }
  }
})

test_that("likelihood calculation on real data", {
  pc <- powerconsumption[powerconsumption$week == 5, ]
  dts <- cut(pc$active_power, breaks = c(0, quantile(pc$active_power, probs = c(0.5, 1))))
  dts_cov <- data.frame(day_night = (pc$hour >= 7 & pc$hour <= 17))
  m_cov <- covlmc(dts, dts_cov, min_size = 5, alpha = 0.1)
  for (initial in c("truncated", "specific", "extended")) {
    fll <- loglikelihood(m_cov, initial = initial, newdata = dts, newcov = dts_cov)
    expect_identical(
      fll,
      loglikelihood(m_cov, initial = initial),
      tolerance = 1e-7
    )
    sll <- co_slow_loglikelihood(m_cov, dts, initial = initial, newcov = dts_cov)
    expect_equal(as.numeric(fll), as.numeric(sll))
    expect_equal(attr(fll, "df"), attr(sll, "df"))
    expect_equal(attr(fll, "nobs"), attr(sll, "nobs"))
  }
})

test_that("likelihood calculation on real data with merged models", {
  skip_on_cran()
  skip_on_ci()
  for (engine in c("glm", "multinom")) {
    withr::local_options(mixvlmc.predictive = engine)
    d_model <- build_degenerate_elec_model(FALSE)
    for (initial in c("truncated", "specific", "extended")) {
      fll <- loglikelihood(d_model$model,
        newdata = d_model$dts,
        newcov = d_model$cov,
        initial = initial
      )
      expect_identical(fll,
        loglikelihood(d_model$model, initial = initial),
        tolerance = 1e-7
      )
      sll <- co_slow_loglikelihood(d_model$model,
        newdata = d_model$dts,
        initial = initial,
        newcov = d_model$cov
      )
      expect_equal(as.numeric(fll), as.numeric(sll))
    }
  }
})

test_that("likelihood calculation artifical data with merged models", {
  for (engine in c("glm", "multinom")) {
    withr::local_options(mixvlmc.predictive = engine)
    d_model <- create_demo_covlmc()
    for (initial in c("truncated", "specific", "extended")) {
      fll <- loglikelihood(d_model$model,
        newdata = d_model$dts,
        newcov = d_model$cov,
        initial = initial
      )
      expect_identical(fll,
        loglikelihood(d_model$model, initial = initial),
        tolerance = 1e-7
      )
      sll <- co_slow_loglikelihood(d_model$model,
        newdata = d_model$dts,
        initial = initial,
        newcov = d_model$cov
      )
      expect_equal(as.numeric(fll), as.numeric(sll))
    }
  }
})