tests/testthat/test-compare_accuracy.R

In verasls/lvmisc: Veras Miscellaneous

test_that("error handling works", {
  m1 <- lm(Sepal.Length ~ Species, data = iris)
  m2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris)

  expect_error(
    compare_accuracy(m1, m2, quiet = "true"),
    "`quiet` must be logical; not character.",
    class = "error_argument_type"
  )
  expect_error(
    compare_accuracy(m1, m2, rank_by = "R2_marg"),
    glue::glue(
      "`rank_by` must be one of \"Model\", \"Class\", \"R2\", \"R2_adj\", \\
      \"AIC\", \"BIC\", \"MAE\", \"MAPE\" or \"RMSE\""
    ),
    class = "error_argument_value"
  )
})

test_that("compare_accuracy() works for models of class lm", {
  m1 <- lm(Sepal.Length ~ Species, data = iris)
  m2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris)
  out <- compare_accuracy(m1, m2)

  col_names <- c(
    "Model", "Class", "R2", "R2_adj", "AIC", "BIC", "MAE", "MAPE", "RMSE"
  )
  expect_equal(names(out), col_names)
  expect_equal(as.character(out[["Class"]]), c("lm", "lm"))
})

test_that("compare_accuracy() works for models of class lmerMod", {
  m1 <- lme4::lmer(
    Sepal.Length ~ Sepal.Width + (1 | Species), data = iris, REML = FALSE
  )
  m2 <- lme4::lmer(
    Sepal.Length ~ Sepal.Width + Petal.Length + (1 | Species), data = iris
  )
  out <- compare_accuracy(m1, m2, quiet = TRUE)

  col_names <- c(
    "Model", "Class", "R2_marg", "R2_cond", "AIC", "BIC", "MAE", "MAPE", "RMSE"
  )
  expect_equal(names(out), col_names)
  expect_equal(as.character(out[["Class"]]), c("lmerMod", "lmerMod"))
})

test_that("compare_accuracy() works for models of class lvmisc_cv", {
  mtcars <- tibble::as_tibble(mtcars, rownames = "cars")
  m1 <- lm(disp ~ mpg, mtcars)
  m2 <- lm(disp ~ mpg + hp, mtcars)
  cv1 <- loo_cv(m1, mtcars, cars)
  cv2 <- loo_cv(m2, mtcars, cars)
  out <- compare_accuracy(cv1, cv2, quiet = TRUE)

  col_names <- c(
    "Model", "Class", "R2", "R2_adj", "AIC", "BIC", "MAE", "MAPE", "RMSE"
  )
  expect_equal(names(out), col_names)
  expect_equal(
    as.character(out[["Class"]]), c("lvmisc_cv_model/lm", "lvmisc_cv_model/lm")
  )
})

test_that("compare_accuracy() works for models of different classes", {
  mtcars <- tibble::as_tibble(mtcars, rownames = "cars")
  m1 <- lm(Sepal.Length ~ Species, data = iris)
  m2 <- lme4::lmer(
    Sepal.Length ~ Sepal.Width + Petal.Length + (1 | Species), data = iris
  )
  m3 <- lm(disp ~ mpg * hp, mtcars)
  cv3 <- loo_cv(m3, mtcars, cars)
  out <- compare_accuracy(m1, m2, cv3, quiet = TRUE)

  col_names <- c(
    "Model", "Class", "R2", "R2_adj", "R2_marg", "R2_cond",
    "AIC", "BIC", "MAE", "MAPE", "RMSE"
  )
  expect_equal(names(out), col_names)
  expect_equal(
    as.character(out[["Class"]]),
    c("lm", "lmerMod", "lvmisc_cv_model/lm")
  )
})

test_that("compare_accuracy() throws the correct warnigns", {
  mtcars <- tibble::as_tibble(mtcars, rownames = "cars")
  m1 <- lm(Sepal.Length ~ Species, data = iris)
  m2 <- lme4::lmer(
    Sepal.Length ~ Sepal.Width + Petal.Length + (1 | Species), data = iris
  )
  m3 <- lme4::lmer(
    Sepal.Length ~ Sepal.Width * Petal.Length + (1 | Species), data = iris
  )
  m4 <- lm(disp ~ mpg * hp, mtcars)
  cv4 <- loo_cv(m4, mtcars, cars)

  expect_warning(
    compare_accuracy(m1, m4),
    "Not all models have the same response variable."
  )
  expect_warning(
    compare_accuracy(m4, cv4),
    "Not all models are of the same class."
  )
  expect_warning(
    compare_accuracy(m2, m3),
    "Some models were refit using maximum likelihood."
  )
})

test_that("rank_by argument works", {
  m1 <- lm(Sepal.Length ~ Species, data = iris)
  m2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris)
  out <- compare_accuracy(m1, m2, rank_by = "AIC")

  expect_true(out$AIC[1] < out$AIC[2])
})