tests/testthat/test_iaibase.R

In iai: Interface to 'Interpretable AI' Modules

context("IAIBase")


X <- iris[, 1:4]
y <- iris$Species

test_that("Split data and fitting",  {
  skip_on_cran()

  # Test numeric indexing of list returns
  split <- iai::split_data("classification", X, y, train_proportion = 0.75)
  train_X <- split[[1]][[1]]
  train_y <- split[[1]][[2]]
  test_X <- split[[2]][[1]]
  test_y <- split[[2]][[2]]

  expect_equal(nrow(train_X) + nrow(test_X), nrow(X))
  expect_equal(length(train_y) + length(test_y), length(y))

  # Test imputation split
  if (iai:::iai_version_less_than("3.0.0")) {
    split <- iai::split_data("imputation", X, train_proportion = 0.75)
    train_X <- split[[1]][[1]]
    test_X <- split[[2]][[1]]
    expect_equal(nrow(train_X) + nrow(test_X), nrow(X))
  } else {
    expect_error(iai::split_data("imputation", X),
                 "Cannot use `split_data` with `imputation`")
  }

  # Test prescription names
  treatments <- y
  outcomes <- X[, 1]
  split <- iai::split_data("prescription_minimize", X, treatments, outcomes)
  train_X <- split$train$X
  train_treatments <- split$train$treatments
  train_outcomes <- split$train$outcomes
  test_X <- split$test$X
  test_treatments <- split$test$treatments
  test_outcomes <- split$test$outcomes

  expect_equal(nrow(train_X) + nrow(test_X), nrow(X))
  expect_equal(length(train_treatments) + length(test_treatments),
               length(treatments))
  expect_equal(length(train_outcomes) + length(test_outcomes), length(outcomes))
})


test_that("score", {
  skip_on_cran()

  y <- runif(100)
  y_pred <- rep(y)

  if (iai:::iai_version_less_than("2.1.0")) {
    expect_error(iai::score("classification", y_pred, y,
                            criterion = "misclassification"),
                 "requires IAI version 2.1.0")
  } else {
    expect_equal(iai::score("classification", y_pred, y,
                            criterion = "misclassification"),
                 1.0)
    expect_equal(iai::score("regression", y_pred, y,
                            criterion = "mse"),
                 1.0)
    expect_equal(iai::score("survival", 1 - y_pred, rep(TRUE, 100), y,
                            criterion = "harrell_c_statistic"),
                 1.0)
  }
})


test_that("Split mixed data",  {
  skip_on_cran()

  # Add a mixed data column (numeric + categoric)
  tmp <- 10 * X[, 4]
  tmp[1:5] <- NA
  tmp[6:10] <- "not measured"
  X$numericmixed <- iai::as.mixeddata(tmp, c("not measured"))

  # Add another mixed data column (ordinal + categoric)
  tmp2 <- c(rep("Small", 40), rep("Medium", 60), rep("Large", 50))
  tmp2[1:5] <- "not measured"
  tmp2[6:10] <- NA
  X$ordinalmixed <- iai::as.mixeddata(tmp2, c("not measured"),
                                      c("Small", "Medium", "Large"))

  # Split into derivation and testing
  split <- iai::split_data("classification", X, y, train_proportion = 0.75)
  train_X <- split[[1]][[1]]
  train_y <- split[[1]][[2]]
  test_X <- split[[2]][[1]]
  test_y <- split[[2]][[2]]

  # Check if the combined split_data outputs are the same as original
  expect_true(all(
      c(train_X$numericmixed, test_X$numericmixed) %in% X$numericmixed))
  expect_true(all(
      X$numericmixed %in% c(train_X$numericmixed, test_X$numericmixed)))

  expect_true(all(
      c(train_X$ordinalmixed, test_X$ordinalmixed) %in% X$ordinalmixed))
  expect_true(all(
      X$ordinalmixed %in% c(train_X$ordinalmixed, test_X$ordinalmixed)))

})


test_that("grid_search", {
  skip_on_cran()

  grid <- iai::grid_search(
      iai::optimal_tree_classifier(
          random_seed = 1,
          max_depth = 1,
      ),
  )
  iai::fit(grid, X, y)

  expect_equal(class(grid), c(
      "grid_search",
      "optimal_tree_classifier",
      "optimal_tree_learner",
      "classification_tree_learner",
      "tree_learner",
      "classification_learner",
      "supervised_learner",
      "learner",
      "IAIObject",
      "JuliaObject"
  ))

  expect_equal(iai::get_best_params(grid), list(cp = 0.25))
  lifecycle::expect_deprecated(iai::get_grid_results(grid))
  expect_true(is.data.frame(iai::get_grid_result_summary(grid)))

  if (iai:::iai_version_less_than("2.2.0")) {
    expect_error(iai::get_grid_result_details(grid),
                 "requires IAI version 2.2.0")
  } else {
    d <- iai::get_grid_result_details(grid)
    expect_true(is.list(d))
    expect_true("params" %in% names(d[[1]]))
    expect_true("valid_score" %in% names(d[[1]]))
    expect_true("rank" %in% names(d[[1]]))
    expect_true("fold_results" %in% names(d[[1]]))
    f <- d[[1]]$fold_results
    expect_true(is.list(f))
    expect_true("train_score" %in% names(f[[1]]))
    expect_true("valid_score" %in% names(f[[1]]))
    expect_true("learner" %in% names(f[[1]]))
    expect_true("optimal_tree_learner" %in% class(f[[1]]$learner))
  }

  expect_true("optimal_tree_learner" %in% class(iai::get_learner(grid)))
})


test_that("roc_curve", {
  skip_on_cran()

  lnr <- iai::optimal_tree_classifier(max_depth = 0, cp = 0)
  iai::fit(lnr, X, y == "setosa")
  roc <- iai::roc_curve(lnr, X, y == "setosa")

  expect_equal(class(roc), c(
      "roc_curve",
      "IAIObject",
      "JuliaObject"
  ))

  if (iai:::iai_version_less_than("1.1.0")) {
    expect_error(iai::show_in_browser(roc), "requires IAI version 1.1.0")
    expect_error(iai::write_html("roc.html", roc), "requires IAI version 1.1.0")
  } else {
    iai::write_html("roc.html", roc)
    expect_true(file.exists("roc.html"))
    file.remove("roc.html")
  }

  probs <- runif(10)
  y <- rbinom(10, 1, 0.5)
  positive_label <- 1

  if (iai:::iai_version_less_than("2.0.0")) {
    expect_error(iai::roc_curve(probs, y, positive_label = positive_label),
                 "requires IAI version 2.0.0")
  } else {
    # positive_label not specified
    expect_error(iai::roc_curve(probs, y), "positive_label")

    roc <- iai::roc_curve(probs, y, positive_label = positive_label)
    expect_equal(class(roc), c(
        "roc_curve",
        "IAIObject",
        "JuliaObject"
    ))
  }

  if (iai:::iai_version_less_than("2.1.0")) {
    expect_error(iai::get_roc_curve_data(roc), "requires IAI version 2.1.0")
  } else {
    data <- iai::get_roc_curve_data(roc)
    expect_true("auc" %in% names(data))
    expect_true("coords" %in% names(data))
    c <- data$coords[1]
    expect_true("tpr" %in% names(c))
    expect_true("fpr" %in% names(c))
    expect_true("threshold" %in% names(c))
  }
})


test_that("policy", {
  skip_on_cran()

  if (!iai:::iai_version_less_than("2.0.0")) {
    X <- iris[, 1:4]
    rewards <- iris[, 1:3]
    lnr <- iai::optimal_tree_policy_minimizer(max_depth = 0, cp = 0)
    iai::fit(lnr, X, rewards)
  }

  if (iai:::iai_version_less_than("2.1.0")) {
    expect_error(iai::predict_treatment_rank(), "requires IAI version 2.1.0")
    expect_error(iai::predict_treatment_outcome(), "requires IAI version 2.1.0")
  } else {
    rank <- iai::predict_treatment_rank(lnr, X)
    expect_true(is.matrix(rank))
    expect_equal(nrow(rank), nrow(rewards))
    expect_equal(ncol(rank), ncol(rewards))

    outcomes <- iai::predict_treatment_outcome(lnr, X)
    expect_true(is.data.frame(outcomes))
    expect_equal(nrow(outcomes), nrow(rewards))
    expect_equal(ncol(outcomes), ncol(rewards))
  }
})


test_that("rich output", {
  skip_on_cran()

  iai::set_rich_output_param("test", "abc")
  expect_equal(iai::get_rich_output_params(), list(test = "abc"))
  iai::delete_rich_output_param("test")
  params <- iai::get_rich_output_params()
  expect_true(is.list(params) && length(params) == 0)
})


test_that("learner params", {
  skip_on_cran()

  lnr <- iai::optimal_tree_classifier(cp = 0)
  iai::set_params(lnr, max_depth = 1)
  expect_equal(iai::get_params(lnr)$max_depth, 1)

  iai::fit(lnr, X, y)

  new_lnr <- iai::clone(lnr)
  expect_true("optimal_tree_learner" %in% class(new_lnr))
  # Clone has same params
  expect_equal(iai::get_params(new_lnr)$max_depth, 1)
  # Clone is not fitted
  expect_error(iai::predict(new_lnr))
})


test_that("add_julia_processes", {
  skip_on_cran()

  iai::add_julia_processes(1)

  # Make sure process was added
  expect_equal(JuliaCall::julia_eval("Distributed.nprocs()"), 2)

  # Make sure we can fit a model
  X <- iris[, 1:4]
  y <- iris$Species
  grid <- iai::grid_search(iai::optimal_tree_classifier(max_depth = 1))
  iai::fit(grid, X, y)

  # Make sure process is still added, then remove
  expect_equal(JuliaCall::julia_eval("Distributed.nprocs()"), 2)
  JuliaCall::julia_eval("Distributed.rmprocs(Distributed.workers())")
  expect_equal(JuliaCall::julia_eval("Distributed.nprocs()"), 1)
})


test_that("get_machine_id", {
  skip_on_cran()

  if (iai:::iai_version_less_than("1.2.0")) {
    id <- JuliaCall::julia_eval("IAI.IAIBase.machine_id()")
  } else {
    id <- JuliaCall::julia_eval("IAI.IAILicensing.machine_id()")
  }

  expect_equal(iai::get_machine_id(), id)
})

test_that("resume_from_checkpoint", {
  skip_on_cran()

  if (iai:::iai_version_less_than("3.1.0")) {
    expect_error(iai::resume_from_checkpoint(), "requires IAI version 3.1.0")
  } else {
    X <- iris[, 1:4]
    y <- iris$Species

    # OptimalTrees
    d <- tempfile()
    lnr1 <- iai::optimal_tree_classifier(cp = 0, max_depth = 4,
                                         checkpoint_dir = d)
    iai::fit(lnr1, X, y)

    f <- file.path(d, "checkpoint.json")
    lnr2 <- iai::resume_from_checkpoint(f)

    expect_equal(lnr1, lnr2)

    # RewardEstimation
    d <- tempfile()
    lnr1 <- iai::categorical_regression_reward_estimator(
        propensity_estimator = iai::xgboost_classifier(num_round = 5),
        propensity_insample_num_folds = 2,
        outcome_estimator = iai::xgboost_regressor(num_round = 5),
        outcome_insample_num_folds = 2,
        reward_estimator = "doubly_robust",
        checkpoint_dir = d,
    )
    out1 <- iai::fit_predict(lnr1, X, y, X$Sepal.Length)

    f <- file.path(d, "checkpoint.json")
    tmp <- iai::resume_from_checkpoint(f)
    lnr2 <- tmp$learner
    out2 <- tmp$results

    # convert to str
    iai::set_params(lnr2, reward_estimator = lnr1$reward_estimator)

    expect_equal(lnr1, lnr2)
    expect_true(all(out1$predictions$reward == out2$predictions$reward))
  }
})

test_that("multi API", {
  skip_on_cran()

  if (iai:::iai_version_less_than("3.2.0")) {
    expect_error(iai::optimal_tree_multi_classifier(),
                 "requires IAI version 3.2.0")
  } else {
    X <- iris[, 1:3]
    y <- iris[, 4:5]
    y[, 1] <- y[, 1] == y[1, 1]
    y[, 2] <- y[, 2] == y[1, 2]

    lnr <- iai::optimal_tree_multi_classifier(max_depth = 1, cp = 0)
    iai::fit(lnr, X, y)

    pred_all <- iai::predict(lnr, X)
    expect_true(is.list(pred_all))
    pred_single <- iai::predict(lnr, X, "Species")
    expect_true(is.logical(pred_single) && length(pred_single) == nrow(X))
    expect_equal(pred_all$Species, pred_single)

    score_all <- iai::score(lnr, X, y)
    expect_true(is.numeric(score_all) && length(score_all) == 1)
    score_single <- iai::score(lnr, X, y, "Species")
    expect_true(is.numeric(score_single) && length(score_single) == 1)
    expect_false(score_all == score_single)

    proba_all <- iai::predict_proba(lnr, X)
    expect_true(is.list(proba_all))
    proba_single <- iai::predict_proba(lnr, X, "Species")
    expect_true(is.data.frame(proba_single))
    expect_equal(proba_all$Species, proba_single)

    roc_all <- iai::roc_curve(lnr, X, y, positive_label=c(T, F))
    expect_true(is.list(roc_all))
    expect_true("roc_curve" %in% class(roc_all[[1]]))
    roc_single <- iai::roc_curve(lnr, X, y, "Species", positive_label=F)
    expect_true("roc_curve" %in% class(roc_single))
    expect_equal(roc_all$Species, roc_single)
  }
})