add tests, passing along maintainer role (#11)

* make `plot_min_depth_distribution` work with ranger forests

* first pass adding ranger support for min_depth_interactions, untested

* first pass adding ranger support for multi way importance, untested

* further clean up to the point explain_forest works for ranger

* unsupervised randomForest should be supported by all functions except plot_predict_interaction

* add my email address

* unfinished work adding tests

* first pass ranfomForest tests

* add tests for ranger and fix an issue with interactions for ranger

* add .travis.yml

* pass along maintainer role

Author: Yue-Jiang

.travis.yml

@@ -0,0 +1,14 @@
+# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r
+
+language: r
+r:
+  - release
+  - devel
+sudo: false
+cache: packages
+
+r_packages:
+  - covr
+
+after_success:
+  - Rscript -e 'library(covr); codecov()'

DESCRIPTION

@@ -2,9 +2,9 @@ Package: randomForestExplainer
 Title: Explaining and Visualizing Random Forests in Terms of Variable Importance
 Version: 0.9
 Authors@R: c(
-  person("Aleksandra", "Paluszynska", email = "[email protected]", role = c("aut", "cre")),
+  person("Aleksandra", "Paluszynska", email = "[email protected]", role = c("aut")),
   person("Przemyslaw", "Biecek", email = "[email protected]", role = c("aut","ths")),
-  person("Yue", "Jiang", role = "aut")
+  person("Yue", "Jiang", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9798-5517"))
   )
 Description: A set of tools to help explain which variables are most important in a random forests. Various variable importance measures are calculated and visualized in different settings in order to get an idea on how their importance changes depending on our criteria (Hemant Ishwaran and Udaya B. Kogalur and Eiran Z. Gorodeski and Andy J. Minn and Michael S. Lauer (2010) <doi:10.1198/jasa.2009.tm08622>, Leo Breiman (2001) <doi:10.1023/A:1010933404324>).
 Depends: R (>= 3.0)
@@ -25,7 +25,8 @@ Imports:
   reshape2 (>= 1.4.2),
   rmarkdown (>= 1.5)
 Suggests:
-  knitr
+    knitr,
+    testthat
 VignetteBuilder: knitr
 RoxygenNote: 6.1.1
 URL: https://github.com/ModelOriented/randomForestExplainer

R/explain_forest.R

@@ -25,7 +25,7 @@ explain_forest <- function(forest, interactions = FALSE, data = NULL, vars = NUL
                            measures = NULL){
   if(is.null(measures)){
     if("randomForest" %in% class(forest)){
-      if(forest$type == "classification"){
+      if(forest$type %in% c("classification", "unsupervised")){
         measures <- c("mean_min_depth", "accuracy_decrease", "gini_decrease", "no_of_nodes", "times_a_root")
       } else{
         measures <- c("mean_min_depth", "mse_increase", "node_purity_increase", "no_of_nodes", "times_a_root")
@@ -36,7 +36,7 @@ explain_forest <- function(forest, interactions = FALSE, data = NULL, vars = NUL
   }
   if("randomForest" %in% class(forest) && dim(forest$importance)[2] == 1){
     stop(paste("Your forest does not contain information on local importance so",
-               ifelse(forest$type == "classification", "accuracy_decrease", "mse_increase"),
+               ifelse(forest$type %in% c("classification", "unsupervised"), "accuracy_decrease", "mse_increase"),
                "measure cannot be extracted.",
                "To add it regrow the forest with the option localImp = TRUE and run this function again."))
   }

R/measure_importance.R

@@ -31,7 +31,7 @@ measure_no_of_nodes_ranger <- function(forest_table){
 # Extract randomForest variable importance measures
 # randomForest
 measure_vimp <- function(forest, only_nonlocal = FALSE){
-  if(forest$type == "classification"){
+  if(forest$type %in% c("classification", "unsupervised")){
     if(dim(forest$importance)[2] == 1){
       if(only_nonlocal == FALSE){
         print("Warning: your forest does not contain information on local importance so 'accuracy_decrease' measure cannot be extracted. To add it regrow the forest with the option localImp = TRUE and run this function again.")
@@ -129,7 +129,7 @@ measure_importance <- function(forest, mean_sample = "top_trees", measures = NUL
 measure_importance.randomForest <- function(forest, mean_sample = "top_trees", measures = NULL){
   tree <- NULL; `split var` <- NULL; depth <- NULL
   if(is.null(measures)){
-    if(forest$type == "classification"){
+    if(forest$type %in% c("classification", "unsupervised")){
       measures <- c("mean_min_depth", "no_of_nodes", "accuracy_decrease",
                     "gini_decrease", "no_of_trees", "times_a_root", "p_value")
     } else if(forest$type =="regression"){
@@ -143,6 +143,9 @@ measure_importance.randomForest <- function(forest, mean_sample = "top_trees", m
   importance_frame <- data.frame(variable = rownames(forest$importance), stringsAsFactors = FALSE)
   # Get objects necessary to calculate importance measures based on the tree structure
   if(any(c("mean_min_depth", "no_of_nodes", "no_of_trees", "times_a_root", "p_value") %in% measures)){
+    if (is.null(forest$forest)) {
+      stop("Make sure forest has been saved when calling randomForest by randomForest(..., keep.forest = TRUE).")
+    }
     forest_table <-
       lapply(1:forest$ntree, function(i) randomForest::getTree(forest, k = i, labelVar = T) %>%
                calculate_tree_depth() %>% cbind(tree = i)) %>% rbindlist()
@@ -159,7 +162,7 @@ measure_importance.randomForest <- function(forest, mean_sample = "top_trees", m
     importance_frame <- merge(importance_frame, measure_no_of_nodes(forest_table), all = TRUE)
     importance_frame[is.na(importance_frame$no_of_nodes), "no_of_nodes"] <- 0
   }
-  if(forest$type == "classification"){
+  if(forest$type %in% c("classification", "unsupervised")){
     vimp <- c("accuracy_decrease", "gini_decrease")
   } else if(forest$type =="regression"){
     vimp <- c("mse_increase", "node_purity_increase")

R/min_depth_interactions.R

@@ -39,11 +39,11 @@ conditional_depth_ranger <- function(frame, vars){
         df <- frame[begin:nrow(frame), setdiff(names(frame), setdiff(vars, j))]
         df[[j]][1] <- 0
         for(k in 2:nrow(df)){
-          if(length(df[(!is.na(df[, "leftChild"]) & df[, "leftChild"] == as.numeric(df[k, "number"])) |
-                       (!is.na(df[, "rightChild"]) & df[, "rightChild"] == as.numeric(df[k, "number"])), j]) != 0){
+          if(length(df[(!is.na(df[, "leftChild"]) & df[, "leftChild"] == as.numeric(df[k, "number"]) - 1) |
+                       (!is.na(df[, "rightChild"]) & df[, "rightChild"] == as.numeric(df[k, "number"]) - 1), j]) != 0){
             df[k, j] <-
-              df[(!is.na(df[, "leftChild"]) & df[, "leftChild"] == as.numeric(df[k, "number"])) |
-                   (!is.na(df[, "rightChild"]) & df[, "rightChild"] == as.numeric(df[k, "number"])), j] + 1
+              df[(!is.na(df[, "leftChild"]) & df[, "leftChild"] == as.numeric(df[k, "number"]) - 1) |
+                   (!is.na(df[, "rightChild"]) & df[, "rightChild"] == as.numeric(df[k, "number"]) - 1), j] + 1
           }
         }
         frame[begin:nrow(frame), setdiff(names(frame), setdiff(vars, j))] <- df
@@ -68,7 +68,7 @@ min_depth_interactions_values <- function(forest, vars){
   mean_tree_depth <- dplyr::group_by(interactions_frame[, c("tree", vars)], tree) %>%
     dplyr::summarize_at(vars, funs(max(., na.rm = TRUE))) %>% as.data.frame()
   mean_tree_depth[mean_tree_depth == -Inf] <- NA
-  mean_tree_depth <- colMeans(mean_tree_depth[, vars], na.rm = TRUE)
+  mean_tree_depth <- colMeans(mean_tree_depth[, vars, drop = FALSE], na.rm = TRUE)
   min_depth_interactions_frame <-
     interactions_frame %>% dplyr::group_by(tree, `split var`) %>%
     dplyr::summarize_at(vars, funs(min(., na.rm = TRUE))) %>% as.data.frame()
@@ -93,7 +93,7 @@ min_depth_interactions_values_ranger <- function(forest, vars){
   mean_tree_depth <- dplyr::group_by(interactions_frame[, c("tree", vars)], tree) %>%
     dplyr::summarize_at(vars, funs(max(., na.rm = TRUE))) %>% as.data.frame()
   mean_tree_depth[mean_tree_depth == -Inf] <- NA
-  mean_tree_depth <- colMeans(mean_tree_depth[, vars], na.rm = TRUE)
+  mean_tree_depth <- colMeans(mean_tree_depth[, vars, drop = FALSE], na.rm = TRUE)
   min_depth_interactions_frame <-
     interactions_frame %>% dplyr::group_by(tree, splitvarName) %>%
     dplyr::summarize_at(vars, funs(min(., na.rm = TRUE))) %>% as.data.frame()
@@ -146,15 +146,15 @@ min_depth_interactions.randomForest <- function(forest, vars = important_variabl
     non_occurrences[, -1] <- forest$ntree - occurrences[, -1]
     interactions_frame[is.na(as.matrix(interactions_frame))] <- 0
     interactions_frame[, -1] <- (interactions_frame[, -1] * occurrences[, -1] +
-                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth))/forest$ntree
+                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth, nrow = length(mean_tree_depth)))/forest$ntree
   } else if(mean_sample == "top_trees"){
     non_occurrences <- occurrences
     non_occurrences[, -1] <- forest$ntree - occurrences[, -1]
     minimum_non_occurrences <- min(non_occurrences[, -1])
     non_occurrences[, -1] <- non_occurrences[, -1] - minimum_non_occurrences
     interactions_frame[is.na(as.matrix(interactions_frame))] <- 0
     interactions_frame[, -1] <- (interactions_frame[, -1] * occurrences[, -1] +
-                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth))/(forest$ntree - minimum_non_occurrences)
+                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth, nrow = length(mean_tree_depth)))/(forest$ntree - minimum_non_occurrences)
   }
   interactions_frame <- reshape2::melt(interactions_frame, id.vars = "variable")
   colnames(interactions_frame)[2:3] <- c("root_variable", "mean_min_depth")
@@ -195,15 +195,15 @@ min_depth_interactions.ranger <- function(forest, vars = important_variables(mea
     non_occurrences[, -1] <- forest$num.trees - occurrences[, -1]
     interactions_frame[is.na(as.matrix(interactions_frame))] <- 0
     interactions_frame[, -1] <- (interactions_frame[, -1] * occurrences[, -1] +
-                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth))/forest$num.trees
+                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth, nrow = length(mean_tree_depth)))/forest$num.trees
   } else if(mean_sample == "top_trees"){
     non_occurrences <- occurrences
     non_occurrences[, -1] <- forest$num.trees - occurrences[, -1]
     minimum_non_occurrences <- min(non_occurrences[, -1])
     non_occurrences[, -1] <- non_occurrences[, -1] - minimum_non_occurrences
     interactions_frame[is.na(as.matrix(interactions_frame))] <- 0
     interactions_frame[, -1] <- (interactions_frame[, -1] * occurrences[, -1] +
-                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth))/(forest$num.trees - minimum_non_occurrences)
+                                   as.matrix(non_occurrences[, -1]) %*% diag(mean_tree_depth, nrow = length(mean_tree_depth)))/(forest$num.trees - minimum_non_occurrences)
   }
   interactions_frame <- reshape2::melt(interactions_frame, id.vars = "variable")
   colnames(interactions_frame)[2:3] <- c("root_variable", "mean_min_depth")
@@ -303,6 +303,10 @@ plot_predict_interaction.randomForest <- function(forest, data, variable1, varia
                                                   main = paste0("Prediction of the forest for different values of ",
                                                                 paste0(variable1, paste0(" and ", variable2))),
                                                   time = NULL){
+  if (forest$type == "unsupervised") {
+    warning("plot_predict_interaction cannot be performed on unsupervised random forests.")
+    return(NULL)
+  }
   newdata <- expand.grid(seq(min(data[[variable1]]), max(data[[variable1]]), length.out = grid),
                          seq(min(data[[variable2]]), max(data[[variable2]]), length.out = grid))
   colnames(newdata) <- c(variable1, variable2)

inst/testdata/test_randomForest.rda

@@ -0,0 +1,4 @@
+library(testthat)
+library(randomForestExplainer)
+
+test_check("randomForestExplainer")

inst/testdata/test_ranger.rda

@@ -0,0 +1,100 @@
+library(randomForest)
+library(dplyr)
+load(system.file("testdata/test_randomForest.rda", package="randomForestExplainer", mustWork=TRUE))
+# Test input generated by:
+# library(randomForest)
+# set.seed(12345)
+# rf_c <- randomForest(Species ~ ., data = iris, localImp = TRUE, ntree = 2)
+# rf_r <- randomForest(mpg ~ ., data = mtcars, localImp = TRUE, ntree = 2)
+# rf_u <- randomForest(x = iris, keep.forest = TRUE, localImp = TRUE, ntree = 2)
+# save(rf_c, rf_r, rf_u, file = "inst/testdata/test_randomForest.rda")
+
+
+context("Test randomForest classification forests")
+
+test_that("measure_importance works", {
+  imp_df <- measure_importance(rf_c, mean_sample = "all_trees",
+                               measures = c("mean_min_depth", "accuracy_decrease", "gini_decrease",
+                                            "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(as.character(imp_df$variable),
+               c("Petal.Length", "Petal.Width", "Sepal.Length", "Sepal.Width"))
+})
+
+test_that("important_variables works", {
+  imp_vars <- important_variables(rf_c, k = 3,
+                                  measures = c("mean_min_depth", "accuracy_decrease", "gini_decrease",
+                                               "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(imp_vars, c("Petal.Width", "Petal.Length", "Sepal.Length"))
+})
+
+test_that("min_depth_distribution works", {
+  min_depth_dist <- min_depth_distribution(rf_c)
+  expect_equivalent(min_depth_dist[min_depth_dist$tree == 1 & min_depth_dist$variable == "Petal.Width", ]$minimal_depth,
+                    0)
+})
+
+test_that("min_depth_interactions works", {
+  min_depth_int <- min_depth_interactions(rf_c, vars = c("Petal.Width"))
+  expect_equivalent(min_depth_int[min_depth_int$interaction == "Petal.Width:Sepal.Length", ]$mean_min_depth,
+                    0)
+})
+
+
+context("Test randomForest regression forests")
+
+test_that("measure_importance works", {
+  imp_df <- measure_importance(rf_r, mean_sample = "all_trees",
+                               measures = c("mean_min_depth", "mse_increase", "node_purity_increase",
+                                            "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(as.character(imp_df$variable),
+               c("am", "carb", "cyl", "disp", "drat", "gear", "hp", "qsec", "vs", "wt"))
+})
+
+test_that("important_variables works", {
+  imp_vars <- important_variables(rf_r, k = 3,
+                                  measures = c("mean_min_depth", "mse_increase", "node_purity_increase",
+                                               "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(imp_vars, c("cyl", "disp", "hp", "wt"))
+})
+
+test_that("min_depth_distribution works", {
+  min_depth_dist <- min_depth_distribution(rf_r)
+  expect_equivalent(min_depth_dist[min_depth_dist$tree == 1 & min_depth_dist$variable == "cyl", ]$minimal_depth,
+                    0)
+})
+
+test_that("min_depth_interactions works", {
+  min_depth_int <- min_depth_interactions(rf_r, vars = c("cyl"))
+  expect_equivalent(min_depth_int[min_depth_int$interaction == "cyl:wt", ]$mean_min_depth,
+                    1)
+})
+
+
+context("Test randomForest unsupervised forests")
+
+test_that("measure_importance works", {
+  imp_df <- measure_importance(rf_u, mean_sample = "all_trees",
+                               measures = c("mean_min_depth", "accuracy_decrease", "gini_decrease",
+                                            "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(as.character(imp_df$variable),
+               c("Petal.Length", "Petal.Width", "Sepal.Length", "Sepal.Width", "Species"))
+})
+
+test_that("important_variables works", {
+  imp_vars <- important_variables(rf_u, k = 3,
+                                  measures = c("mean_min_depth", "accuracy_decrease", "gini_decrease",
+                                               "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(imp_vars, c("Petal.Length", "Sepal.Length", "Species"))
+})
+
+test_that("min_depth_distribution works", {
+  min_depth_dist <- min_depth_distribution(rf_u)
+  expect_equivalent(min_depth_dist[min_depth_dist$tree == 1 & min_depth_dist$variable == "Sepal.Width", ]$minimal_depth,
+                    0)
+})
+
+test_that("min_depth_interactions works", {
+  min_depth_int <- min_depth_interactions(rf_u, vars = c("Petal.Width"))
+  expect_equivalent(min_depth_int[min_depth_int$interaction == "Petal.Width:Sepal.Length", ]$mean_min_depth,
+                    1)
+})