tests/testthat/test_describe.R

In iBreakDown: Model Agnostic Instance Level Variable Attributions

context("Check describe() function")

library("DALEX")
library("randomForest")
library("iBreakDown")

titanic <- na.omit(titanic)
model_titanic_rf <- randomForest(survived == "yes" ~ gender + age + class + embarked +
                                  fare + sibsp + parch,  data = titanic)

explain_titanic_rf <- explain(model_titanic_rf,
                              data = titanic[,-9],
                              y = titanic$survived == "yes",
                              label = "Random Forest v7")
random_passanger <- titanic[sample(nrow(titanic),1),c(1,2,3,4,6,7,8)]


rf_la <- break_down(explain_titanic_rf, random_passanger, keep_distributions = TRUE)
test_that("Output format", {
  expect_is(iBreakDown::describe(rf_la), "break_down_description")
})

rf_la <- break_down(explain_titanic_rf, random_passanger, keep_distributions = FALSE)
test_that("Output format", {
  expect_is(iBreakDown::describe(rf_la), "break_down_description")})


test_that("Output format", {
  expect_error(describe(rf_la, display_values = 4))})

n <- 4
test <- expand.grid(replicate(n, c(TRUE,FALSE), simplify = FALSE))
test_result <- apply(test, MARGIN = 1, function(x){
  random_passanger <- titanic[sample(nrow(titanic),1),c(1,2,3,4,6,7,8)]
  rf_la <- break_down(explain_titanic_rf, random_passanger, keep_distributions = TRUE)
  description <- iBreakDown::describe(x = rf_la,
                                      label = "the passanger will survive with probability",
                                      short_description = x[[1]],
                                      display_values =  x[[2]],
                                      display_numbers = x[[3]],
                                      display_distribution_details = x[[4]])
  test_that("Output format", {
    expect_is(description, "break_down_description")
  })
})

n <- 4
test <- expand.grid(replicate(n, c(TRUE,FALSE), simplify = FALSE))
test_result_shap <- apply(test, MARGIN = 1, function(x){
  random_passanger <- titanic[sample(nrow(titanic),1),c(1,2,3,4,6,7,8)]
  rf_la_shap <- shap(explain_titanic_rf, random_passanger, B = 2)
  description <- iBreakDown::describe(x = rf_la_shap,
                                      label = "the passanger will survive with probability",
                                      short_description = x[[1]],
                                      display_values =  x[[2]],
                                      display_numbers = x[[3]],
                                      display_distribution_details = x[[4]],
                                      display_shap = TRUE)
  test_that("Output format", {
    expect_is(description, "break_down_description")
  })
})

## test for less than 3 variables
titanic_small <- titanic[sample(1:nrow(titanic), 500),]


model_small <- glm(survived == "yes" ~ age + gender,
                   data = titanic_small[, c(1,2,9)],
                   family = "binomial")

explain_model_small <- explain(model_small,
                               data = titanic_small[, c(1,2)],
                               y = titanic_small$survived == "yes")


shap_small <- shap(explain_model_small, new_observation = titanic_small[1,c(1,2)])
bd_small <- break_down(explain_model_small, new_observation = titanic_small[1,c(1,2)])

test_that("Output format", {
  expect_is(iBreakDown::describe(shap_small, display_numbers = TRUE,
                                 display_values = TRUE, display_shap = TRUE)
            ,"break_down_description")
})

test_that("Output format", {
  expect_is(iBreakDown::describe(bd_small, display_numers = TRUE,
                                 display_values = TRUE)
            ,"break_down_description")
})