Reactivate all unit tests

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: shapviz
 Title: SHAP Visualizations
-Version: 0.9.2
+Version: 0.9.3
 Authors@R: c(
     person("Michael", "Mayer", , "mayermichael79@gmail.com", role = c("aut", "cre")),
     person("Adrian", "Stando", , "adrian.j.stando@gmail.com", role = "ctb")

NEWS.md

@@ -1,3 +1,10 @@
+# shapviz 0.9.3
+
+## Other changes
+
+- Re-activate all unit tests.
+- Added "How to contribute" to README.
+
 # shapviz 0.9.2
 
 ## User-visible changes

README.md

@@ -60,6 +60,13 @@ install.packages("shapviz")
 devtools::install_github("ModelOriented/shapviz")
 ```
 
+## How to contribute
+
+Contributions are very welcome!
+
+1. The first step: open a Github issue to describe the problem or the missing feature.
+2. Then, we check who will implement it. 
+
 ## Usage
 
 Shiny diamonds... let's use XGBoost to model their prices by the four "C" variables:

packaging.R

@@ -15,7 +15,7 @@ library(usethis)
 use_description(
   fields = list(
     Title = "SHAP Visualizations",
-    Version = "0.9.2",
+    Version = "0.9.3",
     Description = "Visualizations for SHAP (SHapley Additive exPlanations),
     such as waterfall plots, force plots, various types of importance plots,
     dependence plots, and interaction plots.

tests/testthat/test-collapse_shap.R

@@ -85,15 +85,15 @@ test_that("collapse_shap works for SHAP interactions and two collapses (result i
 })
 
 # # Real data example
-# form <- Sepal.Length ~ Sepal.Width + Species - 1
-# iris_dummy <- model.matrix(form, data = iris)
-# dtrain <- xgboost::xgb.DMatrix(iris_dummy, label = iris[, 1L])
-# fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L)
-# coll <- list(Species = paste0("Species", levels(iris$Species)))
-#
-# test_that("Collapse works using XGB API", {
-#   expect_no_error(
-#     x <- shapviz(fit, X_pred = dtrain, X = iris, collapse = coll, interactions = TRUE)
-#   )
-#   expect_identical(colnames(x), c("Sepal.Width", "Species"))
-# })
+form <- Sepal.Length ~ Sepal.Width + Species - 1
+iris_dummy <- model.matrix(form, data = iris)
+dtrain <- xgboost::xgb.DMatrix(iris_dummy, label = iris[, 1L])
+fit <- xgboost::xgb.train(params = list(nthread = 1L), data = dtrain, nrounds = 1L)
+coll <- list(Species = paste0("Species", levels(iris$Species)))
+
+test_that("Collapse works using XGB API", {
+  expect_no_error(
+    x <- shapviz(fit, X_pred = dtrain, X = iris, collapse = coll, interactions = TRUE)
+  )
+  expect_identical(colnames(x), c("Sepal.Width", "Species"))
+})

tests/testthat/test-interface.R

@@ -212,38 +212,38 @@ test_that("mshapviz object contains original shapviz objects", {
 })
 
 # # Multiclass with XGBoost
-# X_pred <- data.matrix(iris[, -5L])
-# dtrain <- xgboost::xgb.DMatrix(X_pred, label = as.integer(iris[, 5L]) - 1L)
-# fit <- xgboost::xgb.train(
-#   params = list(nthread = 1L),
-#   data = dtrain,
-#   nrounds = 1L,
-#   objective="multi:softprob",
-#   num_class = 3L
-# )
-# shp3 <- shapviz(fit, X_pred = X_pred, which_class = 3L, interactions = TRUE)
-# mshp <- shapviz(fit, X_pred = X_pred, interactions = TRUE)
-#
-# test_that("is.shapviz() and is.mshapviz() functions work", {
-#   expect_true(is.shapviz(shp3))
-#   expect_true(is.mshapviz(mshp))
-#   expect_false(is.shapviz(mshp))
-#   expect_false(is.mshapviz(shp3))
-# })
-#
-# test_that("shapviz on class 3 equals mshapviz[[3]] for classification", {
-#   expect_equal(mshp[[3L]], shp3)
-# })
-#
-# test_that("combining shapviz on classes 1, 2, 3 equal mshapviz", {
-#   shp1 <- shapviz(fit, X_pred = X_pred, which_class = 1L, interactions = TRUE)
-#   shp2 <- shapviz(fit, X_pred = X_pred, which_class = 2L, interactions = TRUE)
-#   expect_equal(mshp, c(Class_1 = shp1, Class_2 = shp2, Class_3 = shp3))
-#   expect_equal(mshp, mshapviz(list(Class_1 = shp1, Class_2 = shp2, Class_3 = shp3)))
-# })
-#
-# test_that("combining non-shapviz objects fails", {
-#   expect_error(c(shp3, 1))
-#   expect_error(mshapviz(1, 2))
-# })
-#
+X_pred <- data.matrix(iris[, -5L])
+dtrain <- xgboost::xgb.DMatrix(X_pred, label = as.integer(iris[, 5L]) - 1L)
+fit <- xgboost::xgb.train(
+  params = list(nthread = 1L),
+  data = dtrain,
+  nrounds = 1L,
+  objective="multi:softprob",
+  num_class = 3L
+)
+shp3 <- shapviz(fit, X_pred = X_pred, which_class = 3L, interactions = TRUE)
+mshp <- shapviz(fit, X_pred = X_pred, interactions = TRUE)
+
+test_that("is.shapviz() and is.mshapviz() functions work", {
+  expect_true(is.shapviz(shp3))
+  expect_true(is.mshapviz(mshp))
+  expect_false(is.shapviz(mshp))
+  expect_false(is.mshapviz(shp3))
+})
+
+test_that("shapviz on class 3 equals mshapviz[[3]] for classification", {
+  expect_equal(mshp[[3L]], shp3)
+})
+
+test_that("combining shapviz on classes 1, 2, 3 equal mshapviz", {
+  shp1 <- shapviz(fit, X_pred = X_pred, which_class = 1L, interactions = TRUE)
+  shp2 <- shapviz(fit, X_pred = X_pred, which_class = 2L, interactions = TRUE)
+  expect_equal(mshp, c(Class_1 = shp1, Class_2 = shp2, Class_3 = shp3))
+  expect_equal(mshp, mshapviz(list(Class_1 = shp1, Class_2 = shp2, Class_3 = shp3)))
+})
+
+test_that("combining non-shapviz objects fails", {
+  expect_error(c(shp3, 1))
+  expect_error(mshapviz(1, 2))
+})
+

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")))
+})