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

Author: Yue-Jiang

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

inst/testdata/test_ranger.rda

@@ -1,34 +1,100 @@
 library(ranger)
 library(dplyr)
-set.seed(12345)
+load(system.file("testdata/test_ranger.rda", package="randomForestExplainer", mustWork=TRUE))
+# Test input generated by:
+# library(ranger)
+# library(survival)
+# set.seed(12345)
+# ranger_c <- ranger(Species ~ ., data = iris, importance = "impurity", num.trees = 2)
+# ranger_r <- ranger(mpg ~ ., data = mtcars, importance = "impurity", num.trees = 2)
+# ranger_s <- ranger(Surv(futime, fustat) ~ ., data = ovarian, importance = "impurity", num.trees = 2)
+# save(ranger_c, ranger_r, ranger_s, file = "inst/testdata/test_ranger.rda")
+
 
 context("Test ranger classification forests")
-forest <- ranger(Species ~ ., data = iris, probability = TRUE, num.trees = 2, importance = "impurity")
 
 test_that("measure_importance works", {
-  imp_df <- measure_importance(forest, mean_sample = "all_trees",
+  imp_df <- measure_importance(ranger_c, mean_sample = "all_trees",
+                               measures = c("mean_min_depth", "impurity",
+                                            "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(ranger_c, k = 3,
+                                  measures = c("mean_min_depth", "impurity",
+                                               "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(ranger_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(ranger_c, vars = c("Petal.Width"))
+  expect_equivalent(min_depth_int[min_depth_int$interaction == "Petal.Width:Sepal.Length", ]$mean_min_depth,
+                    1.5)
+})
+
+
+context("Test ranger regression forests")
+
+test_that("measure_importance works", {
+  imp_df <- measure_importance(ranger_r, mean_sample = "all_trees",
+                               measures = c("mean_min_depth", "impurity",
+                                            "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(ranger_r, k = 3,
+                                  measures = c("mean_min_depth", "impurity",
+                                               "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(imp_vars, c("wt", "cyl", "disp"))
+})
+
+test_that("min_depth_distribution works", {
+  min_depth_dist <- min_depth_distribution(ranger_r)
+  expect_equivalent(min_depth_dist[min_depth_dist$tree == 2 & min_depth_dist$variable == "cyl", ]$minimal_depth,
+                    0)
+})
+
+test_that("min_depth_interactions works", {
+  min_depth_int <- min_depth_interactions(ranger_r, vars = c("cyl"))
+  expect_equivalent(min_depth_int[min_depth_int$interaction == "cyl:wt", ]$mean_min_depth,
+                    0.5)
+})
+
+
+context("Test ranger survival forests")
+
+test_that("measure_importance works", {
+  imp_df <- measure_importance(ranger_s, mean_sample = "all_trees",
                                measures = c("mean_min_depth", "impurity",
-                                            "no_of_nodes", "times_a_root"))
-  expect_equal(imp_df$variable, c("Petal.Length", "Petal.Width", "Sepal.Length", "Sepal.Width"))
+                                            "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(as.character(imp_df$variable),
+               c("age", "ecog.ps", "resid.ds", "rx"))
 })
 
 test_that("important_variables works", {
-  imp_vars <- important_variables(forest, k = 3,
+  imp_vars <- important_variables(ranger_s, k = 3,
                                   measures = c("mean_min_depth", "impurity",
-                                               "no_of_nodes", "times_a_root"))
-  expect_equal(imp_vars, c("Petal.Width", "Sepal.Length", "Petal.Length"))
+                                               "no_of_nodes", "times_a_root", "p_value"))
+  expect_equal(imp_vars, c("age", "ecog.ps", "rx"))
 })
 
 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, 2, 2, 2),
-                               "variable"=c("Petal.Width", "Sepal.Length", "Petal.Length", "Petal.Width", "Sepal.Length", "Sepal.Width"),
-                               "minimal_depth"=c(0, 2, 3, 0, 3, 3), stringsAsFactors = FALSE))
+  min_depth_dist <- min_depth_distribution(ranger_s)
+  expect_equivalent(min_depth_dist[min_depth_dist$tree == 1 & min_depth_dist$variable == "age", ]$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(ranger_s, vars = c("age"))
+  expect_equivalent(min_depth_int[min_depth_int$interaction == "age:ecog.ps", ]$mean_min_depth,
+                    0.5)
 })