tests/testthat/test-deepsplitting.R

In Rforestry: Random Forests, Linear Trees, and Gradient Boosting for Inference and Interpretability

context("Deep splitting")

test_that('Deep splitting obeys variable selection restrictions', {

  set.seed(1)
  n <- 100
  p <- 4
  x <- matrix(rnorm(n * p), ncol = p)
  y <- rnorm(n)
  forest <- forestry(
    x, y, interactionDepth = 3, maxDepth = 20, interactionVariables = 0:1, mtry = 1,
    ntree = 100,nthread = 2)
  forest <- make_savable(forest)
  for(tree.id in 1:forest@ntree) {
    # This is an unsightly hack to recover variables used for splitting in tree
    # above and below interactionDepth

    out <- plot(forest, tree.id = tree.id)
    node_matrix <- out$x$nodes
    shallow_variables <- sort(unique(subset(node_matrix, level < 3)$label))
    shallow_variables <- shallow_variables[nchar(shallow_variables) < 5]
    expect_true(all(shallow_variables %in% c("V3", "V4")))

    deep_variables <- sort(unique(subset(node_matrix, level >= 3)$label))
    deep_variables <- deep_variables[nchar(deep_variables) < 5]
    expect_true(length(deep_variables) == p)
  }
})


test_that("Test that deep splitting has finite run time when mtry > number of non zero entries in featureWeights", {
  set.seed(1)
  n <- 100
  p <- 4
  x <- matrix(rnorm(n * p), ncol = p)
  y <- rnorm(n)
  forest <- forestry(
    x, y, interactionDepth = 3, maxDepth = 20, interactionVariables = 0:1, mtry = 3,
    ntree = 100,nthread = 2,scale=FALSE)
  forest <- make_savable(forest)
  for(tree.id in 1:forest@ntree) {
    # This is an unsightly hack to recover variables used for splitting in tree
    # above and below interactionDepth

    out <- plot(forest, tree.id = tree.id)
    node_matrix <- out$x$nodes
    shallow_variables <- sort(unique(subset(node_matrix, level < 3)$label))
    shallow_variables <- shallow_variables[nchar(shallow_variables) < 5]
    expect_true(all(shallow_variables %in% c("V3", "V4")))

    deep_variables <- sort(unique(subset(node_matrix, level >= 3)$label))
    deep_variables <- deep_variables[nchar(deep_variables) < 5]
    expect_true(length(deep_variables) == p)
  }
})