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")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.