tests/testthat/test-collection_labels.R

In familiar: End-to-End Automated Machine Learning and Model Evaluation

# Don't perform any further tests on CRAN due to running time.
testthat::skip_on_cran()
testthat::skip_on_ci()

for (outcome_type in c("continuous", "multinomial", "survival")) {
  
  if (!familiar:::test_data_package_installed(outcome_type)) next
  
  # Get data.
  data <- familiar:::test_create_good_data(outcome_type = outcome_type)

  # Select simple regression models to train with.
  learner <- switch(
    outcome_type,
    "continuous" = "glm_gaussian",
    "multinomial" = "glm_multinomial",
    "survival" = "cox")

  # Data elements to skip.
  skip_data_elements <- c("ice_data", "permutation_vimp")

  # Create experiment data.
  experiment_data <- familiar::summon_familiar(
    data = data,
    experimental_design = "fs+mb",
    fs_method = "mim",
    imputation_method = "simple",
    learner = learner,
    estimation_type = "point",
    skip_evaluation_elements = skip_data_elements,
    parallel = FALSE)

  # Test both familiarCollection and familiarModel objects.
  familiar_collection_list <- list(
    "collection" = experiment_data$familiarCollection,
    "model" = familiar::as_familiar_collection(
      object = experiment_data$familiarModel,
      data = data,
      familiar_data_names = "development",
      estimation_type = "point",
      data_element = setdiff(familiar:::.get_available_data_elements(), skip_data_elements)))

  # class names ----------------------------------------------------------------
  for (collection in familiar_collection_list) {
    class_names <- familiar::get_class_names(collection)

    testthat::test_that(
      "Class names are correctly read and updated.",
      {
        if (outcome_type %in% c("binomial", "multinomial")) {
          # Test equality of the set.
          testthat::expect_setequal(class_names, levels(data@data$outcome))

          # Replace class names.
          new_class_names <- paste0("class_", seq_along(class_names))
          collection <- familiar::set_class_names(
            collection,
            old = rev(class_names),
            new = rev(new_class_names))

          # Expect that the labels are the same and have the same order as the
          # original labels.
          testthat::expect_equal(
            familiar::get_class_names(collection),
            new_class_names)

          # Reorder levels.
          collection <- familiar::set_class_names(
            collection,
            order = rev(new_class_names))

          # Expect that the labels are now re-ordered.
          testthat::expect_equal(
            familiar::get_class_names(collection),
            rev(new_class_names))
          
        } else {
          testthat::expect_equal(class_names, character(0L))
        }
      }
    )
  }

  # data set names -------------------------------------------------------------
  for (collection in familiar_collection_list) {
    data_set_names <- familiar::get_data_set_names(collection)

    testthat::test_that(
      "Dataset names are correct",
      {
        testthat::expect_setequal(data_set_names, "development")

        # Replace data set names.
        new_data_set_names <- paste0("data_set", seq_along(data_set_names))
        collection <- familiar::set_data_set_names(
          collection,
          old = "development",
          new = new_data_set_names)

        # Expect that the labels are the same and have the same order as the
        # original labels.
        testthat::expect_equal(
          familiar::get_data_set_names(collection),
          new_data_set_names)
      }
    )
  }

  # feature names --------------------------------------------------------------
  for (collection in familiar_collection_list) {
    feature_names <- familiar::get_feature_names(collection)

    testthat::test_that(
      "Feature names are correct",
      {
        testthat::expect_equal(
          all(feature_names %in% familiar:::get_feature_columns(data)),
          TRUE)

        # Replace feature names.
        new_feature_names <- paste0("feature_", seq_along(feature_names))
        collection <- familiar::set_feature_names(
          collection,
          old = rev(feature_names),
          new = rev(new_feature_names))

        # Expect that the labels are the same and have the same order as the
        # original labels.
        testthat::expect_equal(
          familiar::get_feature_names(collection),
          new_feature_names)

        # Reorder levels.
        collection <- familiar::set_feature_names(
          collection,
          order = rev(new_feature_names))

        # Expect that the labels are now re-ordered.
        testthat::expect_equal(
          familiar::get_feature_names(collection),
          rev(new_feature_names))
      }
    )
  }

  # vimp names -----------------------------------------------------------------
  for (collection in familiar_collection_list) {
    vimp_names <- familiar::get_fs_method_names(collection)

    testthat::test_that(
      "VIMP names are correct",
      {
        testthat::expect_equal(vimp_names, "mim")

        # Replace vimp-method names.
        new_vimp_names <- paste0("vimp_method_", seq_along(vimp_names))
        collection <- familiar::set_fs_method_names(
          collection,
          old = vimp_names,
          new = new_vimp_names)

        # Expect that the labels are the same and have the same order as the
        # original labels.
        testthat::expect_equal(
          familiar::get_fs_method_names(collection),
          new_vimp_names)
      }
    )
  }

  # learner names --------------------------------------------------------------
  for (collection in familiar_collection_list) {
    learner_names <- familiar::get_learner_names(collection)

    testthat::test_that(
      "Learner names are correct",
      {
        testthat::expect_equal(learner_names, learner)

        # Replace learner names.
        new_learner_names <- paste0("learner_", seq_along(learner_names))
        collection <- familiar::set_learner_names(
          collection,
          old = learner_names,
          new = new_learner_names)

        # Expect that the labels are the same and have the same order as the
        # original labels.
        testthat::expect_equal(
          familiar::get_learner_names(collection),
          new_learner_names)
      }
    )
  }

  # risk group names -----------------------------------------------------------
  for (collection in familiar_collection_list) {
    risk_group_names <- familiar::get_risk_group_names(collection)

    testthat::test_that(
      "Risk group names are correct",
      {
        if (outcome_type %in% c("survival")) {
          testthat::expect_setequal(
            risk_group_names,
            c("low", "moderate", "high"))

          # Replace risk-group names.
          new_risk_group_names <- paste0("risk_group", seq_along(risk_group_names))
          collection <- familiar::set_risk_group_names(
            collection,
            old = rev(risk_group_names),
            new = rev(new_risk_group_names))

          # Expect that the labels are the same and have the same order as the
          # original labels.
          testthat::expect_equal(
            familiar::get_risk_group_names(collection),
            new_risk_group_names)

          # Reorder levels.
          collection <- familiar::set_risk_group_names(
            collection,
            order = rev(new_risk_group_names))

          # Expect that the labels are now re-ordered.
          testthat::expect_equal(
            familiar::get_risk_group_names(collection),
            rev(new_risk_group_names))
          
        } else {
          testthat::expect_equal(
            risk_group_names,
            c("low", "moderate", "high"))
        }
      }
    )
  }
}