tests/testthat/test-evaluate.R

In healthcareai: Tools for Healthcare Machine Learning

context("Checking evaluate")

# Setup
d <- na.omit(pima_diabetes)[1:100, ]
dtest <- na.omit(pima_diabetes)[101:110, ]

m_df <- iris
mtest <- iris[seq(1, 150, 10), ]

r_models <- machine_learn(d, patient_id, outcome = plasma_glucose, tune = FALSE, n_folds = 2)
r_models_eval <- evaluate(r_models)
c_models <- machine_learn(d, patient_id, outcome = diabetes, tune = FALSE, n_folds = 2)
c_models_eval <- evaluate(c_models)
m_models <- machine_learn(d = m_df, outcome = Species, tune = FALSE, n_folds = 2)
m_models_eval <- evaluate(m_models)

r_preds_training <- predict(r_models)
r_preds_train_eval <- evaluate(r_preds_training)
r_preds_test_eval <- predict(r_models, dtest) %>% evaluate()
c_preds_training <- predict(c_models)
c_preds_train_eval <- evaluate(c_preds_training)
c_preds_test_eval <- predict(c_models, dtest) %>% evaluate()
# m_preds_training <- predict(m_models) # nolint
# m_preds_train_eval <- evaluate(m_preds_training) # nolint
# m_preds_test_eval <- predict(m_models, dtest) %>% evaluate() # nolint

all_evals <- list(r_models_eval, c_models_eval, m_models_eval,
                  r_preds_train_eval, c_preds_train_eval,
                  r_preds_test_eval, c_preds_test_eval)

# Test
test_that("evalute_classification returns numeric with names being metrics", {
  eval_class <- evaluate_classification(c(.3, .7, .8), c(0, 1, 0))
  expect_true(is.numeric(eval_class))
  expect_setequal(names(eval_class), c("AUPR", "AUROC"))
})

test_that("evalute_regression returns numeric with names being metrics", {
  eval_reg <- evaluate_regression(c(.3, .7, .8), c(4, 6, 9))
  expect_true(is.numeric(eval_reg))
  expect_setequal(names(eval_reg), c("RMSE", "MAE", "Rsquared"))
})

test_that("evalute_regression returns numeric with names being metrics", {
  eval_reg <- evaluate_multiclass(iris$Species, sample(iris$Species))
  expect_true(is.numeric(eval_reg))
  expect_setequal(names(eval_reg), c("Accuracy", "Kappa"))
})

test_that("evaluate is a registered S3 generic with methods for models and predictions", {
  expect_true("evaluate.predicted_df" %in% methods("evaluate"))
  expect_true("evaluate.model_list" %in% methods("evaluate"))
})

test_that("All evaluate methods return numeric vector", {
  purrr::map_lgl(all_evals, is.numeric) %>%
    all() %>%
    expect_true()
})

test_that("All evalutes methods returns appropriate metrics", {
  expect_setequal(names(r_preds_train_eval), c("RMSE", "MAE", "Rsquared"))
  expect_setequal(names(r_preds_test_eval), c("RMSE", "MAE", "Rsquared"))
  expect_setequal(names(r_models_eval), c("RMSE", "MAE", "Rsquared"))
  expect_setequal(names(c_preds_train_eval), c("AUPR", "AUROC"))
  expect_setequal(names(c_preds_test_eval), c("AUPR", "AUROC"))
  expect_setequal(names(c_models_eval), c("AUPR", "AUROC"))
  # expect_setequal(names(m_preds_train_eval), c("Accuracy", "Kappa")) # nolint
  # expect_setequal(names(m_preds_test_eval), c("Accuracy", "Kappa")) # nolint
  # expect_setequal(names(m_models_eval), c("Accuracy", "Kappa")) # nolint
})

test_that("All classification metrics are in [0, 1]", {
  purrr::map_lgl(c_preds_test_eval, ~ .x <= 1 && .x >= 0) %>%
    all() %>%
    expect_true()
  purrr::map_lgl(c_models_eval, ~ .x <= 1 && .x >= 0) %>%
    all() %>%
    expect_true()
})

test_that("evaluate predicted barfs if target isn't present", {
  expect_error(
    dplyr::select(dtest, -plasma_glucose) %>%
      predict(r_models, .) %>%
      evaluate()
    , regexp = "plasma_glucose")
  expect_error(
    dtest %>%
      predict(c_models, .) %>%
      dplyr::select(-diabetes) %>%
      evaluate()
    , regexp = "diabetes")
})

test_that("evaluate model_list metrics match caret's", {
  expect_equal(attributes(r_preds_training)$model_info$performance,
               r_models_eval[["RMSE"]])
  expect_equal(attributes(c_preds_training)$model_info$performance,
               c_models_eval[["AUROC"]])
})

test_that("evalute all_models works right", {
  alls <- list(
    r_all = evaluate(r_models, all_models = TRUE),
    c_all = evaluate(c_models, all_models = TRUE),
    m_all = evaluate(m_models, all_models = TRUE),
    all1 = evaluate(r_models[1], all_models = TRUE)
  )
  purrr::map_lgl(alls, is.data.frame) %>% all() %>% expect_true()
  (diff(alls$r_all$RMSE) >= 0) %>% all() %>% expect_true()
  (diff(alls$c_all$AUROC) <= 0) %>% all() %>% expect_true()
  (diff(alls$m_all$Accuracy) <= 0) %>% all() %>% expect_true()
})

test_that("evaluate.predicted_df na.rm works", {
  r_preds_training$plasma_glucose[1] <- NA
  evaluate(r_preds_training) %>% is.na() %>% all() %>% expect_true()
  evaluate(r_preds_training, na.rm = TRUE) %>% is.na() %>% any() %>% expect_false()
})