tests/testthat/test_break.R

context("Check broken() function")

HR_data <- breakDown::HR_data
wine <- breakDown::wine

model_classif_rf <- randomForest::randomForest(factor(left)~., data = breakDown::HR_data, ntree = 50)
model_regr_lm <- lm(quality~., data = breakDown::wine)
model_classif_glm <- glm(factor(left)~., data = breakDown::HR_data, family = "binomial")


predict_function_rf <- function(model, x) predict(model, x, type = "prob")[,2]
predict_function_glm <- function(model, x) predict(model, x, type = "response")

new_observation_classif <- HR_data[11,-7]
new_observation_regr <- wine[8,-12]


broken_rf_classif <- broken(model_classif_rf, new_observation_classif, data = HR_data[,-7],
                        predict.function = predict_function_rf, direction = "down")

broken_lm_regr <- broken(model_regr_lm, new_observation_regr, data = wine[,-12], direction = "up")

broken_glm_classif <- broken(model_classif_glm, new_observation_classif, data = HR_data[,-7], direction = "up")

broken_glm_classif_extended<- broken(model_classif_glm, new_observation_classif, data = HR_data[,-7], direction = "up", baseline="intercept")
broken_rf_classif_extended<- broken_rf_classif <- broken(model_classif_rf, new_observation_classif, data = HR_data[,-7],
                                                         predict.function = predict_function_rf, direction = "down", baseline="intercept")
broken_lm_regr_extended <- broken(model_regr_lm, new_observation_regr, data=wine[,-12], baseline="intercept")

test_that("Output format",{
  expect_is(broken_rf_classif, "broken")
  expect_is(broken_lm_regr, "broken")
  expect_is(broken_glm_classif, "broken")
  expect_length(broken_rf_classif, 7)
  expect_length(broken_lm_regr, 7)
  expect_length(broken_glm_classif, 7)
  expect_output(str(broken_glm_classif), "List of 7")
  expect_is(broken_glm_classif_extended, "broken")
  expect_is(broken_rf_classif_extended, "broken")
  expect_is(broken_lm_regr_extended, "broken")
})
pbiecek/breakDown documentation built on March 15, 2024, 10:46 a.m.