tests/testthat/test-MDI-reg.R

In tree.interpreter: Random Forest Prediction Decomposition and Feature Importance Measure

library(ranger)
library(randomForest)

test_that('MDI works for ranger & regression tree', {
  set.seed(42L)
  rfobj <- ranger(mpg ~ ., mtcars,
                  keep.inbag = TRUE, importance = 'impurity')
  tidy.RF <- tidyRF(rfobj, mtcars[, -1], mtcars[, 1])

  mtcars.MDITree <- MDITree(tidy.RF, 1, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDITree), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDITree),
               list(names(mtcars[, -1]),
                    'Response'))

  mtcars.MDI <- MDI(tidy.RF, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDI), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDI),
               list(names(mtcars[, -1]),
                    'Response'))
  expect_equal(as.vector(rowSums(mtcars.MDI)),
               as.vector(ranger::importance(rfobj) /
                         sum(tidy.RF$inbag.counts[[1]])))
})

test_that('MDI works for randomForest & regression tree', {
  set.seed(42L)
  rfobj <- randomForest(mpg ~ ., mtcars,
                        keep.inbag = TRUE, importance = TRUE)
  tidy.RF <- tidyRF(rfobj, mtcars[, -1], mtcars[, 1])

  mtcars.MDITree <- MDITree(tidy.RF, 1, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDITree), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDITree),
               list(names(mtcars[, -1]),
                    'Response'))

  mtcars.MDI <- MDI(tidy.RF, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDI), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDI),
               list(names(mtcars[, -1]),
                    'Response'))
  expect_equal(as.vector(rowSums(mtcars.MDI)),
               as.vector(importance(rfobj)[, 'IncNodePurity'] /
                         sum(tidy.RF$inbag.counts[[1]])),
               tolerance = 1e-6)
})

test_that('MDIoob works for ranger & regression tree', {
  set.seed(42L)
  rfobj <- ranger(mpg ~ ., mtcars, keep.inbag = TRUE)
  tidy.RF <- tidyRF(rfobj, mtcars[, -1], mtcars[, 1])

  mtcars.MDIoobTree <- MDIoobTree(tidy.RF, 1, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDIoobTree), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDIoobTree),
               list(names(mtcars[, -1]),
                    'Response'))

  mtcars.MDIoob <- MDIoob(tidy.RF, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDIoob), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDIoob),
               list(names(mtcars[, -1]),
                    'Response'))
})

test_that('MDIoob works for randomForest & regression tree', {
  set.seed(42L)
  rfobj <- randomForest(mpg ~ ., mtcars, keep.inbag = TRUE)
  tidy.RF <- tidyRF(rfobj, mtcars[, -1], mtcars[, 1])

  mtcars.MDIoobTree <- MDIoobTree(tidy.RF, 1, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDIoobTree), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDIoobTree),
               list(names(mtcars[, -1]),
                    'Response'))

  mtcars.MDIoob <- MDIoob(tidy.RF, mtcars[, -1], mtcars[, 1])
  expect_equal(dim(mtcars.MDIoob), c(ncol(mtcars) - 1, 1))
  expect_equal(dimnames(mtcars.MDIoob),
               list(names(mtcars[, -1]),
                    'Response'))
})

test_that(paste('MDIoob emits error for ranger & regression tree',
                'when keep.inbag = FALSE'), {
  set.seed(42L)
  rfobj <- ranger(mpg ~ ., mtcars)
  expect_warning(tidy.RF <- tidyRF(rfobj, mtcars[, -1], mtcars[, 1]),
                 'keep.inbag = FALSE; all samples will be considered in-bag.')

  expect_error(MDIoobTree(tidy.RF, 1, mtcars[, -1], mtcars[, 1]),
               'No out-of-bag data available.')
  expect_error(MDIoob(tidy.RF, mtcars[, -1], mtcars[, 1]),
               'No out-of-bag data available.')
})

test_that(paste('MDIoob emits error for randomForest & regression tree',
                'when keep.inbag = FALSE'), {
  set.seed(42L)
  rfobj <- randomForest(mpg ~ ., mtcars)
  expect_warning(tidy.RF <- tidyRF(rfobj, mtcars[, -1], mtcars[, 1]),
                 'keep.inbag = FALSE; all samples will be considered in-bag.')

  expect_error(MDIoobTree(tidy.RF, 1, mtcars[, -1], mtcars[, 1]),
               'No out-of-bag data available.')
  expect_error(MDIoob(tidy.RF, mtcars[, -1], mtcars[, 1]),
               'No out-of-bag data available.')
})