diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 23ac783..00fdd20 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ Version: 0.9.2 -Date: 2023-10-14 16:08:56 UTC -SHA: e923bacb41fd1057fd831e39ef13fe899a935e63 +Date: 2023-10-14 16:44:29 UTC +SHA: 1d239694c309c6b48168b2ca19b8fd5c8d6f1d2d diff --git a/NEWS.md b/NEWS.md index f65c3b4..f973365 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,7 @@ ## Other changes - Revised vignette on "mshapviz". +- Commenting out most unit tests as they would not pass timings measured on Debian. # shapviz 0.9.1 diff --git a/cran-comments.md b/cran-comments.md index 80be3df..c040929 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -2,7 +2,7 @@ ## Resubmission 7 -No effect of setDTthreads(2). Removing now all tests with xgboost. +No effect of setDTthreads(2). Commenting out now all tests with xgboost. ## Resubmission 6 diff --git a/tests/testthat/test-plots-mshapviz.R b/tests/testthat/test-plots-mshapviz.R index 0d676a5..f726041 100644 --- a/tests/testthat/test-plots-mshapviz.R +++ b/tests/testthat/test-plots-mshapviz.R @@ -1,120 +1,120 @@ -dtrain <- xgboost::xgb.DMatrix(data.matrix(iris[, -1L]), label = iris[, 1L]) -fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) -x <- shapviz(fit, X_pred = dtrain, X = iris[, -1L]) -x <- c(m1 = x, m2 = x) - -test_that("plots work for basic example", { - expect_s3_class(sv_waterfall(x, 2), "patchwork") - suppressMessages(expect_s3_class(sv_waterfall(x, 2:3), "patchwork")) - expect_s3_class(sv_force(x, 2), "patchwork") - suppressMessages(expect_s3_class(sv_force(x, 2:3), "patchwork")) - expect_s3_class(sv_importance(x), "ggplot") - expect_s3_class(sv_importance(x, bar_type = "stack"), "ggplot") - expect_s3_class(sv_importance(x, bar_type = "facets"), "ggplot") - expect_s3_class( - sv_importance(x, show_numbers = TRUE, bar_type = "separate"), "patchwork" - ) - expect_s3_class(sv_importance(x, kind = "beeswarm"), "patchwork") - expect_s3_class(sv_dependence(x, "Petal.Length"), "patchwork") - expect_s3_class(sv_dependence2D(x, x = "Petal.Length", y = "Species"), "patchwork") -}) - -test_that("using 'max_display' gives no error", { - expect_s3_class(sv_waterfall(x, 2, max_display = 2L), "patchwork") - suppressMessages(expect_s3_class(sv_waterfall(x, 2:10, max_display = 2L), "patchwork")) - expect_s3_class(sv_force(x, 2, max_display = 2L), "patchwork") - suppressMessages(expect_s3_class(sv_force(x, 2:10, max_display = 2L), "patchwork")) - expect_s3_class(sv_importance(x, max_display = 2L), "ggplot") - expect_s3_class(sv_importance(x, max_display = 2L, bar_type = "stack"), "ggplot") - expect_s3_class(sv_importance(x, max_display = 2L, bar_type = "facets"), "ggplot") - expect_s3_class( - sv_importance(x, max_display = 2L, show_numbers = TRUE, bar_type = "separate"), "patchwork" - ) -}) - -# SHAP interactions -x_inter <- shapviz(fit, X_pred = dtrain, X = iris[, -1L], interactions = TRUE) -x_inter <- c(m1 = x_inter, m2 = x_inter) - -test_that("dependence plots work for interactions = TRUE", { - expect_s3_class( - sv_dependence(x_inter, v = "Petal.Length", interactions = TRUE), - "patchwork" - ) - expect_s3_class( - sv_dependence(x_inter, v = "Petal.Length", interactions = TRUE), - "patchwork" - ) - expect_s3_class( - sv_dependence(x_inter, "Petal.Length", color_var = "Species", interactions = TRUE), - "patchwork" - ) - expect_s3_class( - sv_dependence2D(x_inter, x = "Petal.Length", y = "Species", interactions = TRUE), - "patchwork" - ) -}) - -test_that("main effect plots equal case color_var = v", { - expect_equal( - sv_dependence(x_inter, "Petal.Length", color_var = NULL, interactions = TRUE), - sv_dependence( - x_inter, "Petal.Length", color_var = "Petal.Length", interactions = TRUE - ) - ) -}) - -test_that("Interaction plots provide patchwork object", { - expect_s3_class(sv_interaction(x_inter), "patchwork") -}) - -# Non-standard name -ir <- iris -ir["strange name"] <- ir$Sepal.Width * ir$Petal.Length -dtrain <- xgboost::xgb.DMatrix(data.matrix(ir[, -1L]), label = ir[, 1L]) -fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) -x <- shapviz(fit, X_pred = dtrain, X = ir[, -1L]) -x <- c(m1 = x, m2 = x) - -test_that("plots work for non-syntactic column names", { - expect_s3_class(sv_waterfall(x, 2), "patchwork") - expect_s3_class(sv_force(x, 2), "patchwork") - expect_s3_class(sv_importance(x), "ggplot") - expect_s3_class( - sv_importance(x, bar_type = "separate", show_numbers = TRUE), "patchwork" - ) - expect_s3_class(sv_importance(x, max_display = 2, kind = "beeswarm"), "patchwork") - expect_s3_class(sv_importance(x, kind = "beeswarm"), "patchwork") - expect_s3_class(sv_dependence(x, "strange name"), "patchwork") - expect_s3_class( - sv_dependence(x, "Petal.Length", color_var = "strange name"), "patchwork" - ) - expect_s3_class( - sv_dependence2D(x, x = "Petal.Length", y = "strange name"), "patchwork" - ) -}) - -test_that("sv_importance() and sv_interaction() and kind = 'no' gives matrix", { - X_pred <- data.matrix(iris[, -1L]) - dtrain <- xgboost::xgb.DMatrix(X_pred, label = iris[, 1L]) - fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) - x <- shapviz(fit, X_pred = X_pred, interactions = TRUE) - x <- c(m1 = x, m2 = x) - - imp <- sv_importance(x, kind = "no") - expect_true(is.matrix(imp) && all(dim(imp) == c(4L, length(x)))) - - inter <- sv_interaction(x, kind = "no") - expect_true(is.list(inter) && all(dim(inter[[1L]]) == rep(ncol(X_pred), 2L))) -}) - -test_that("sv_dependence() does not work with multiple v", { - X_pred <- data.matrix(iris[, -1L]) - dtrain <- xgboost::xgb.DMatrix(X_pred, label = iris[, 1L]) - fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) - x <- c(m1 = shapviz(fit, X_pred = X_pred), m2 = shapviz(fit, X_pred = X_pred)) - expect_error(sv_dependence(x, v = c("Species", "Sepal.Width"))) - - expect_error(sv_dependence2D(x, x = c("Species", "Sepal.Width"), y = "Petal.Width")) - expect_error(sv_dependence2D(x, x = "Petal.Width", y = c("Species", "Sepal.Width"))) -}) +# dtrain <- xgboost::xgb.DMatrix(data.matrix(iris[, -1L]), label = iris[, 1L]) +# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) +# x <- shapviz(fit, X_pred = dtrain, X = iris[, -1L]) +# x <- c(m1 = x, m2 = x) +# +# test_that("plots work for basic example", { +# expect_s3_class(sv_waterfall(x, 2), "patchwork") +# suppressMessages(expect_s3_class(sv_waterfall(x, 2:3), "patchwork")) +# expect_s3_class(sv_force(x, 2), "patchwork") +# suppressMessages(expect_s3_class(sv_force(x, 2:3), "patchwork")) +# expect_s3_class(sv_importance(x), "ggplot") +# expect_s3_class(sv_importance(x, bar_type = "stack"), "ggplot") +# expect_s3_class(sv_importance(x, bar_type = "facets"), "ggplot") +# expect_s3_class( +# sv_importance(x, show_numbers = TRUE, bar_type = "separate"), "patchwork" +# ) +# expect_s3_class(sv_importance(x, kind = "beeswarm"), "patchwork") +# expect_s3_class(sv_dependence(x, "Petal.Length"), "patchwork") +# expect_s3_class(sv_dependence2D(x, x = "Petal.Length", y = "Species"), "patchwork") +# }) +# +# test_that("using 'max_display' gives no error", { +# expect_s3_class(sv_waterfall(x, 2, max_display = 2L), "patchwork") +# suppressMessages(expect_s3_class(sv_waterfall(x, 2:10, max_display = 2L), "patchwork")) +# expect_s3_class(sv_force(x, 2, max_display = 2L), "patchwork") +# suppressMessages(expect_s3_class(sv_force(x, 2:10, max_display = 2L), "patchwork")) +# expect_s3_class(sv_importance(x, max_display = 2L), "ggplot") +# expect_s3_class(sv_importance(x, max_display = 2L, bar_type = "stack"), "ggplot") +# expect_s3_class(sv_importance(x, max_display = 2L, bar_type = "facets"), "ggplot") +# expect_s3_class( +# sv_importance(x, max_display = 2L, show_numbers = TRUE, bar_type = "separate"), "patchwork" +# ) +# }) +# +# # SHAP interactions +# x_inter <- shapviz(fit, X_pred = dtrain, X = iris[, -1L], interactions = TRUE) +# x_inter <- c(m1 = x_inter, m2 = x_inter) +# +# test_that("dependence plots work for interactions = TRUE", { +# expect_s3_class( +# sv_dependence(x_inter, v = "Petal.Length", interactions = TRUE), +# "patchwork" +# ) +# expect_s3_class( +# sv_dependence(x_inter, v = "Petal.Length", interactions = TRUE), +# "patchwork" +# ) +# expect_s3_class( +# sv_dependence(x_inter, "Petal.Length", color_var = "Species", interactions = TRUE), +# "patchwork" +# ) +# expect_s3_class( +# sv_dependence2D(x_inter, x = "Petal.Length", y = "Species", interactions = TRUE), +# "patchwork" +# ) +# }) +# +# test_that("main effect plots equal case color_var = v", { +# expect_equal( +# sv_dependence(x_inter, "Petal.Length", color_var = NULL, interactions = TRUE), +# sv_dependence( +# x_inter, "Petal.Length", color_var = "Petal.Length", interactions = TRUE +# ) +# ) +# }) +# +# test_that("Interaction plots provide patchwork object", { +# expect_s3_class(sv_interaction(x_inter), "patchwork") +# }) +# +# # Non-standard name +# ir <- iris +# ir["strange name"] <- ir$Sepal.Width * ir$Petal.Length +# dtrain <- xgboost::xgb.DMatrix(data.matrix(ir[, -1L]), label = ir[, 1L]) +# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) +# x <- shapviz(fit, X_pred = dtrain, X = ir[, -1L]) +# x <- c(m1 = x, m2 = x) +# +# test_that("plots work for non-syntactic column names", { +# expect_s3_class(sv_waterfall(x, 2), "patchwork") +# expect_s3_class(sv_force(x, 2), "patchwork") +# expect_s3_class(sv_importance(x), "ggplot") +# expect_s3_class( +# sv_importance(x, bar_type = "separate", show_numbers = TRUE), "patchwork" +# ) +# expect_s3_class(sv_importance(x, max_display = 2, kind = "beeswarm"), "patchwork") +# expect_s3_class(sv_importance(x, kind = "beeswarm"), "patchwork") +# expect_s3_class(sv_dependence(x, "strange name"), "patchwork") +# expect_s3_class( +# sv_dependence(x, "Petal.Length", color_var = "strange name"), "patchwork" +# ) +# expect_s3_class( +# sv_dependence2D(x, x = "Petal.Length", y = "strange name"), "patchwork" +# ) +# }) +# +# test_that("sv_importance() and sv_interaction() and kind = 'no' gives matrix", { +# X_pred <- data.matrix(iris[, -1L]) +# dtrain <- xgboost::xgb.DMatrix(X_pred, label = iris[, 1L]) +# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) +# x <- shapviz(fit, X_pred = X_pred, interactions = TRUE) +# x <- c(m1 = x, m2 = x) +# +# imp <- sv_importance(x, kind = "no") +# expect_true(is.matrix(imp) && all(dim(imp) == c(4L, length(x)))) +# +# inter <- sv_interaction(x, kind = "no") +# expect_true(is.list(inter) && all(dim(inter[[1L]]) == rep(ncol(X_pred), 2L))) +# }) +# +# test_that("sv_dependence() does not work with multiple v", { +# X_pred <- data.matrix(iris[, -1L]) +# dtrain <- xgboost::xgb.DMatrix(X_pred, label = iris[, 1L]) +# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) +# x <- c(m1 = shapviz(fit, X_pred = X_pred), m2 = shapviz(fit, X_pred = X_pred)) +# expect_error(sv_dependence(x, v = c("Species", "Sepal.Width"))) +# +# expect_error(sv_dependence2D(x, x = c("Species", "Sepal.Width"), y = "Petal.Width")) +# expect_error(sv_dependence2D(x, x = "Petal.Width", y = c("Species", "Sepal.Width"))) +# }) diff --git a/tests/testthat/test-plots-shapviz.R b/tests/testthat/test-plots-shapviz.R index a9e855f..7777a93 100644 --- a/tests/testthat/test-plots-shapviz.R +++ b/tests/testthat/test-plots-shapviz.R @@ -1,173 +1,173 @@ -dtrain <- xgboost::xgb.DMatrix(data.matrix(iris[, -1L]), label = iris[, 1L]) -fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) -x <- shapviz(fit, X_pred = dtrain, X = iris[, -1L]) - -test_that("plots work for basic example", { - expect_s3_class(sv_waterfall(x, 2), "ggplot") - suppressMessages(expect_s3_class(sv_waterfall(x, 2:3), "ggplot")) - expect_s3_class(sv_force(x, 2), "ggplot") - suppressMessages(expect_s3_class(sv_force(x, 2:3), "ggplot")) - expect_s3_class(sv_importance(x), "ggplot") - expect_s3_class(sv_importance(x, show_numbers = TRUE), "ggplot") - expect_s3_class(sv_importance(x, kind = "beeswarm"), "ggplot") - expect_s3_class(sv_dependence(x, "Petal.Length"), "ggplot") - expect_s3_class(sv_dependence(x, c("Petal.Length", "Species")), "patchwork") - expect_s3_class( - sv_dependence( - x, - "Petal.Length", - color_var = c("Petal.Length", "Species"), - jitter_width = c(0, 0.1), - ), - "patchwork" - ) - expect_s3_class(sv_dependence2D(x, x = "Petal.Length", y = "Species"), "ggplot") - expect_s3_class( - sv_dependence2D(x, x = "Petal.Length", y = c("Species", "Petal.Width")), "patchwork" - ) - expect_s3_class( - sv_dependence2D(x, x = c("Petal.Length", "Petal.Width"), y = "Species"), "patchwork" - ) - expect_s3_class( - sv_dependence2D( - x, x = c("Petal.Length", "Petal.Width"), y = c("Species", "Sepal.Width") - ), - "patchwork" - ) -}) - -test_that("using 'max_display' gives no error", { - expect_s3_class(sv_waterfall(x, 2, max_display = 2L), "ggplot") - suppressMessages(expect_s3_class(sv_waterfall(x, 2:10, max_display = 2L), "ggplot")) - expect_s3_class(sv_force(x, 2, max_display = 2L), "ggplot") - suppressMessages(expect_s3_class(sv_force(x, 2:10, max_display = 2L), "ggplot")) - expect_s3_class(sv_importance(x, max_display = 2L), "ggplot") - expect_s3_class(sv_importance(x, max_display = 2L, show_numbers = TRUE), "ggplot") -}) - -# SHAP interactions -x_inter <- shapviz(fit, X_pred = dtrain, X = iris[, -1L], interactions = TRUE) - -test_that("dependence plots work for interactions = TRUE", { - expect_s3_class( - sv_dependence(x_inter, v = "Petal.Length", interactions = TRUE), - "ggplot" - ) - expect_s3_class( - sv_dependence(x_inter, v = c("Petal.Length", "Species"), interactions = TRUE), - "patchwork" - ) - expect_s3_class( - sv_dependence( - x_inter, - v = "Species", - color_var = c("Petal.Length", "Species"), - interactions = TRUE - ), - "patchwork" - ) - - expect_s3_class( - sv_dependence(x_inter, "Petal.Length", color_var = "Species", interactions = TRUE), - "ggplot" - ) - expect_s3_class( - sv_dependence( - x_inter, - v = c("Petal.Length", "Species"), - color_var = "Species", - interactions = TRUE - ), - "patchwork" - ) - - expect_s3_class( - sv_dependence2D(x_inter, x = "Petal.Length", y = "Species", interactions = TRUE), - "ggplot" - ) - expect_s3_class( - sv_dependence2D( - x_inter, x = "Petal.Length", y = c("Species", "Petal.Width"), interactions = TRUE - ), - "patchwork" - ) - expect_s3_class( - sv_dependence2D( - x_inter, x = c("Petal.Length", "Petal.Width"), y = "Species", interactions = TRUE - ), - "patchwork" - ) - expect_s3_class( - sv_dependence2D( - x_inter, - x = c("Petal.Length", "Petal.Width"), - y = c("Species", "Sepal.Width"), - interactions = TRUE - ), - "patchwork" - ) -}) - -test_that("main effect plots equal case color_var = v", { - expect_equal( - sv_dependence(x_inter, "Petal.Length", color_var = NULL, interactions = TRUE), - sv_dependence( - x_inter, "Petal.Length", color_var = "Petal.Length", interactions = TRUE - ) - ) -}) - -test_that("Interaction plots provide ggplot object", { - expect_s3_class(sv_interaction(x_inter), "ggplot") -}) - -# Non-standard name -ir <- iris -ir["strange name"] <- ir$Sepal.Width * ir$Petal.Length -dtrain <- xgboost::xgb.DMatrix(data.matrix(ir[, -1L]), label = ir[, 1L]) -fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) -x <- shapviz(fit, X_pred = dtrain, X = ir[, -1L]) - -test_that("plots work for non-syntactic column names", { - expect_s3_class(sv_waterfall(x, 2), "ggplot") - expect_s3_class(sv_force(x, 2), "ggplot") - expect_s3_class(sv_importance(x), "ggplot") - expect_s3_class(sv_importance(x, show_numbers = TRUE), "ggplot") - expect_s3_class(sv_importance(x, max_display = 2, kind = "beeswarm"), "ggplot") - expect_s3_class(sv_importance(x, kind = "beeswarm"), "ggplot") - expect_s3_class(sv_dependence(x, "strange name"), "ggplot") - expect_s3_class( - sv_dependence(x, "Petal.Length", color_var = "strange name"), "ggplot" - ) - expect_s3_class( - sv_dependence2D(x, x = "Petal.Length", y = "strange name"), "ggplot" - ) -}) - -# Miscellaneous tests -test_that("there are no default sv_*() methods", { - for (f in c( - sv_dependence, - sv_dependence2D, - sv_importance, - sv_force, - sv_waterfall, - sv_interaction - )) { - expect_error(f(1)) - } -}) - -test_that("sv_importance() and sv_interaction() and kind = 'no' gives numeric output", { - X_pred <- data.matrix(iris[, -1L]) - dtrain <- xgboost::xgb.DMatrix(X_pred, label = iris[, 1L]) - fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) - x <- shapviz(fit, X_pred = X_pred, interactions = TRUE) - - imp <- sv_importance(x, kind = "no") - expect_true(is.numeric(imp) && length(imp) == ncol(X_pred)) - - inter <- sv_interaction(x, kind = "no") - expect_true(is.numeric(inter) && all(dim(inter) == rep(ncol(X_pred), 2L))) -}) - +# dtrain <- xgboost::xgb.DMatrix(data.matrix(iris[, -1L]), label = iris[, 1L]) +# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) +# x <- shapviz(fit, X_pred = dtrain, X = iris[, -1L]) +# +# test_that("plots work for basic example", { +# expect_s3_class(sv_waterfall(x, 2), "ggplot") +# suppressMessages(expect_s3_class(sv_waterfall(x, 2:3), "ggplot")) +# expect_s3_class(sv_force(x, 2), "ggplot") +# suppressMessages(expect_s3_class(sv_force(x, 2:3), "ggplot")) +# expect_s3_class(sv_importance(x), "ggplot") +# expect_s3_class(sv_importance(x, show_numbers = TRUE), "ggplot") +# expect_s3_class(sv_importance(x, kind = "beeswarm"), "ggplot") +# expect_s3_class(sv_dependence(x, "Petal.Length"), "ggplot") +# expect_s3_class(sv_dependence(x, c("Petal.Length", "Species")), "patchwork") +# expect_s3_class( +# sv_dependence( +# x, +# "Petal.Length", +# color_var = c("Petal.Length", "Species"), +# jitter_width = c(0, 0.1), +# ), +# "patchwork" +# ) +# expect_s3_class(sv_dependence2D(x, x = "Petal.Length", y = "Species"), "ggplot") +# expect_s3_class( +# sv_dependence2D(x, x = "Petal.Length", y = c("Species", "Petal.Width")), "patchwork" +# ) +# expect_s3_class( +# sv_dependence2D(x, x = c("Petal.Length", "Petal.Width"), y = "Species"), "patchwork" +# ) +# expect_s3_class( +# sv_dependence2D( +# x, x = c("Petal.Length", "Petal.Width"), y = c("Species", "Sepal.Width") +# ), +# "patchwork" +# ) +# }) +# +# test_that("using 'max_display' gives no error", { +# expect_s3_class(sv_waterfall(x, 2, max_display = 2L), "ggplot") +# suppressMessages(expect_s3_class(sv_waterfall(x, 2:10, max_display = 2L), "ggplot")) +# expect_s3_class(sv_force(x, 2, max_display = 2L), "ggplot") +# suppressMessages(expect_s3_class(sv_force(x, 2:10, max_display = 2L), "ggplot")) +# expect_s3_class(sv_importance(x, max_display = 2L), "ggplot") +# expect_s3_class(sv_importance(x, max_display = 2L, show_numbers = TRUE), "ggplot") +# }) +# +# # SHAP interactions +# x_inter <- shapviz(fit, X_pred = dtrain, X = iris[, -1L], interactions = TRUE) +# +# test_that("dependence plots work for interactions = TRUE", { +# expect_s3_class( +# sv_dependence(x_inter, v = "Petal.Length", interactions = TRUE), +# "ggplot" +# ) +# expect_s3_class( +# sv_dependence(x_inter, v = c("Petal.Length", "Species"), interactions = TRUE), +# "patchwork" +# ) +# expect_s3_class( +# sv_dependence( +# x_inter, +# v = "Species", +# color_var = c("Petal.Length", "Species"), +# interactions = TRUE +# ), +# "patchwork" +# ) +# +# expect_s3_class( +# sv_dependence(x_inter, "Petal.Length", color_var = "Species", interactions = TRUE), +# "ggplot" +# ) +# expect_s3_class( +# sv_dependence( +# x_inter, +# v = c("Petal.Length", "Species"), +# color_var = "Species", +# interactions = TRUE +# ), +# "patchwork" +# ) +# +# expect_s3_class( +# sv_dependence2D(x_inter, x = "Petal.Length", y = "Species", interactions = TRUE), +# "ggplot" +# ) +# expect_s3_class( +# sv_dependence2D( +# x_inter, x = "Petal.Length", y = c("Species", "Petal.Width"), interactions = TRUE +# ), +# "patchwork" +# ) +# expect_s3_class( +# sv_dependence2D( +# x_inter, x = c("Petal.Length", "Petal.Width"), y = "Species", interactions = TRUE +# ), +# "patchwork" +# ) +# expect_s3_class( +# sv_dependence2D( +# x_inter, +# x = c("Petal.Length", "Petal.Width"), +# y = c("Species", "Sepal.Width"), +# interactions = TRUE +# ), +# "patchwork" +# ) +# }) +# +# test_that("main effect plots equal case color_var = v", { +# expect_equal( +# sv_dependence(x_inter, "Petal.Length", color_var = NULL, interactions = TRUE), +# sv_dependence( +# x_inter, "Petal.Length", color_var = "Petal.Length", interactions = TRUE +# ) +# ) +# }) +# +# test_that("Interaction plots provide ggplot object", { +# expect_s3_class(sv_interaction(x_inter), "ggplot") +# }) +# +# # Non-standard name +# ir <- iris +# ir["strange name"] <- ir$Sepal.Width * ir$Petal.Length +# dtrain <- xgboost::xgb.DMatrix(data.matrix(ir[, -1L]), label = ir[, 1L]) +# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) +# x <- shapviz(fit, X_pred = dtrain, X = ir[, -1L]) +# +# test_that("plots work for non-syntactic column names", { +# expect_s3_class(sv_waterfall(x, 2), "ggplot") +# expect_s3_class(sv_force(x, 2), "ggplot") +# expect_s3_class(sv_importance(x), "ggplot") +# expect_s3_class(sv_importance(x, show_numbers = TRUE), "ggplot") +# expect_s3_class(sv_importance(x, max_display = 2, kind = "beeswarm"), "ggplot") +# expect_s3_class(sv_importance(x, kind = "beeswarm"), "ggplot") +# expect_s3_class(sv_dependence(x, "strange name"), "ggplot") +# expect_s3_class( +# sv_dependence(x, "Petal.Length", color_var = "strange name"), "ggplot" +# ) +# expect_s3_class( +# sv_dependence2D(x, x = "Petal.Length", y = "strange name"), "ggplot" +# ) +# }) +# +# # Miscellaneous tests +# test_that("there are no default sv_*() methods", { +# for (f in c( +# sv_dependence, +# sv_dependence2D, +# sv_importance, +# sv_force, +# sv_waterfall, +# sv_interaction +# )) { +# expect_error(f(1)) +# } +# }) +# +# test_that("sv_importance() and sv_interaction() and kind = 'no' gives numeric output", { +# X_pred <- data.matrix(iris[, -1L]) +# dtrain <- xgboost::xgb.DMatrix(X_pred, label = iris[, 1L]) +# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L) +# x <- shapviz(fit, X_pred = X_pred, interactions = TRUE) +# +# imp <- sv_importance(x, kind = "no") +# expect_true(is.numeric(imp) && length(imp) == ncol(X_pred)) +# +# inter <- sv_interaction(x, kind = "no") +# expect_true(is.numeric(inter) && all(dim(inter) == rep(ncol(X_pred), 2L))) +# }) +#