tests/testthat/ranger/completed/test_interface.R

In literanger: Random Forests for Multiple Imputation Based on 'ranger'

library(ranger)
library(survival)
context("ranger_interface")

## Formula interface
test_that("All variables included if . in formula", {
  rf <- ranger(Species ~ ., iris, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(colnames(iris)[1:4]))
})

test_that("Variable excluded if - in formula", {
  rf <- ranger(Species ~ . -Petal.Length, iris, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(c("Sepal.Length", "Sepal.Width", "Petal.Width")))
})

test_that("Interaction included if : in formula", {
  rf <- ranger(Species ~ Petal.Length + Sepal.Length:Sepal.Width, iris, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(c("Petal.Length", "Sepal.Length:Sepal.Width")))
})

test_that("Interaction included if * in formula", {
  rf <- ranger(Species ~ Petal.Length + Sepal.Length*Sepal.Width, iris, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(c("Petal.Length", "Sepal.Length", "Sepal.Width", "Sepal.Length:Sepal.Width")))
})

## Formula interface, survival
test_that("All variables included if . in formula", {
  rf <- ranger(Surv(time, status) ~ ., veteran, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(colnames(veteran)[c(1:2, 5:8)]))
})

test_that("Variable excluded if - in formula", {
  rf <- ranger(Surv(time, status) ~ . - celltype - age, veteran, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(c("trt", "karno", "diagtime", "prior")))
})

test_that("Interaction included if : in formula", {
  rf <- ranger(Surv(time, status) ~ celltype + age:prior, veteran, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(c("celltype", "age:prior")))
})

test_that("Interaction included if * in formula", {
  rf <- ranger(Surv(time, status) ~ celltype + age*prior, veteran, num.trees = 5)
  expect_equal(sort(rf$forest$independent.variable.names), 
               sort(c("celltype", "age", "prior", "age:prior")))
})

test_that("Error if interaction of factor variable included", {
  expect_error(ranger(Surv(time, status) ~ celltype*prior, veteran, num.trees = 5), 
               "Error: Only numeric columns allowed in interaction terms.")
})

test_that("Working if dependent variable has attributes other than names", {
  iris2 <- iris
  attr(iris2$Sepal.Width, "aaa") <- "bbb"
  expect_silent(ranger(data = iris2, dependent.variable = "Sepal.Width"))
})

test_that("Working if dependent variable is matrix with one column", {
  iris2 <- iris
  iris2$Sepal.Width = scale(iris$Sepal.Width)
  expect_silent(ranger(data = iris2, dependent.variable = "Sepal.Width"))
})

test_that("Same result with x/y interface, classification", {
  set.seed(300)
  rf_formula <- ranger(Species ~ ., iris, num.trees = 5)
  
  set.seed(300)
  rf_xy <- ranger(y = iris[, 5], x = iris[, -5], num.trees = 5)
  
  expect_equal(rf_formula$prediction.error, rf_xy$prediction.error)
  expect_equal(rf_formula$predictions, rf_xy$predictions)
})

test_that("Same result with x/y interface, regression", {
  set.seed(300)
  rf_formula <- ranger(Sepal.Length ~ ., iris, num.trees = 5)
  
  set.seed(300)
  rf_xy <- ranger(y = iris[, 1], x = iris[, -1], num.trees = 5)
  
  expect_equal(rf_formula$prediction.error, rf_xy$prediction.error)
  expect_equal(rf_formula$predictions, rf_xy$predictions)
})

test_that("Same result with x/y interface, survival", {
  set.seed(300)
  rf_formula <- ranger(Surv(time, status) ~ ., veteran, num.trees = 5)
  
  set.seed(300)
  rf_xy <- ranger(y = veteran[, c(3, 4)], x = veteran[, c(-3, -4)], num.trees = 5)
  
  expect_equal(rf_formula$prediction.error, rf_xy$prediction.error)
  expect_equal(rf_formula$predictions, rf_xy$predictions)
})

test_that("Column order does not change prediction", {
  dat <- iris[, c(sample(1:4), 5)]
  rf <- ranger(dependent.variable.name = "Species", data = iris)
  
  set.seed(42)
  pred1 <- predict(rf, iris)$predictions
  
  set.seed(42)
  pred2 <- predict(rf, dat)$predictions
  
  expect_equal(pred1, pred2)
})

# Tibbles
# This is failing on Rdevel. Possible without suggesting tibble package?
# if (requireNamespace("tibble", quietly = TRUE)) {
#   tb <- tibble::as_tibble(iris)
# }
# test_that("Training works with tibbles, formula interface", {
#   skip_if_not_installed("tibble")
#   set.seed(1000)
#   rf1 <- ranger(Species ~ ., tb, num.trees = 5)
#   
#   set.seed(1000)
#   rf2 <- ranger(Species ~ ., iris, num.trees = 5)
#   
#   expect_equal(rf1$prediction.error, rf2$prediction.error)
#   
#   pred1 <- levels(iris$Species)[rf1$predictions[!is.na(rf1$predictions)]]
#   pred2 <- as.character(rf2$predictions[!is.na(rf2$predictions)])
#   expect_equal(pred1, pred2)
# })
# 
# test_that("Training works with tibbles, alternative interface", {
#   skip_if_not_installed("tibble")
#   set.seed(1000)
#   rf1 <- ranger(dependent.variable.name = "Species", data = tb, num.trees = 5)
#   
#   set.seed(1000)
#   rf2 <- ranger(dependent.variable.name = "Species", data = iris, num.trees = 5)
#   
#   expect_equal(rf1$prediction.error, rf2$prediction.error)
#   
#   pred1 <- levels(iris$Species)[rf1$predictions[!is.na(rf1$predictions)]]
#   pred2 <- as.character(rf2$predictions[!is.na(rf2$predictions)])
#   expect_equal(pred1, pred2)
# })
# 
# test_that("Prediction works with tibbles, formula interface", {
#   skip_if_not_installed("tibble")
#   set.seed(1000)
#   rf1 <- ranger(Species ~ ., tb, num.trees = 5)
#   
#   set.seed(1000)
#   rf2 <- ranger(Species ~ ., iris, num.trees = 5)
#   
#   set.seed(1000)
#   pred1 <- predict(rf1, tb)
#   set.seed(1000)
#   pred2 <- predict(rf1, iris)
#   set.seed(1000)
#   pred3 <- predict(rf2, tb)
#   set.seed(1000)
#   pred4 <- predict(rf2, iris)
#   
#   expect_equal(pred1$predictions, pred2$predictions)
#   expect_equal(pred2$predictions, pred3$predictions)
#   expect_equal(pred3$predictions, pred4$predictions)
# })
# 
# test_that("Prediction works with tibbles, alternative interface", {
#   skip_if_not_installed("tibble")
#   set.seed(1000)
#   rf1 <- ranger(dependent.variable.name = "Species", data = tb, num.trees = 5)
#   
#   set.seed(1000)
#   rf2 <- ranger(dependent.variable.name = "Species", data = iris, num.trees = 5)
#   
#   set.seed(1000)
#   pred1 <- predict(rf1, tb)
#   set.seed(1000)
#   pred2 <- predict(rf1, iris)
#   set.seed(1000)
#   pred3 <- predict(rf2, tb)
#   set.seed(1000)
#   pred4 <- predict(rf2, iris)
#   
#   expect_equal(pred1$predictions, pred2$predictions)
#   expect_equal(pred2$predictions, pred3$predictions)
#   expect_equal(pred3$predictions, pred4$predictions)
# })