first pass ranfomForest tests

Author: Yue-Jiang

R/measure_importance.R

@@ -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()

inst/testdata/test_randomForest.rda

@@ -1,34 +1,100 @@
 library(randomForest)
 library(dplyr)
-set.seed(12345)
+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")
-forest <- randomForest(Species ~ ., data = iris, localImp = TRUE, ntree = 2)
 
 test_that("measure_importance works", {
-  imp_df <- measure_importance(forest, mean_sample = "all_trees",
-                               measures = c("mean_min_depth","accuracy_decrease",
-                                            "gini_decrease", "no_of_nodes", "times_a_root"))
-  expect_equal(imp_df$variable, c("Petal.Length", "Petal.Width", "Sepal.Length", "Sepal.Width"))
+  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(forest, k = 3,
-                                  measures = c("mean_min_depth","accuracy_decrease",
-                                               "gini_decrease", "no_of_nodes", "times_a_root"))
+  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(forest)
-  print(min_depth_dist)
-  expect_equivalent(arrange(min_depth_dist, tree, minimal_depth, variable),
-                    data.frame("tree" = c(1, 1, 1, 1, 2, 2, 2),
-                               "variable"=c("Petal.Width", "Sepal.Length", "Petal.Length", "Sepal.Width", "Petal.Width", "Sepal.Length", "Petal.Length"),
-                               "minimal_depth"=c(0, 1, 2, 4, 0, 1, 3)))
+  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(forest, vars = c("Petal.Width"))
-  expect_equal(as.character(min_depth_int$variable), c("Petal.Length", "Petal.Width", "Sepal.Length", "Sepal.Width"))
+  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)
 })