tests/testthat/test-train.R

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

set.seed(42)
rf_iris_df <- train(data=iris, response_name="Species")
set.seed(42)
rf_iris_mat <- train(data=data.matrix(iris), response_name="Species")

test_that("literanger object returned by train", {
    expect_is(rf_iris_df, "literanger")
    expect_is(rf_iris_mat, "literanger")
})

test_that("trained forest has default number of trees", {
    expect_equal(rf_iris_df$n_tree, formals(literanger::train)$n_tree)
    expect_equal(rf_iris_mat$n_tree, formals(literanger::train)$n_tree)
})

test_that("'predictor_names' does not include the response", {
    expect_equal(setdiff(names(iris), rf_iris_df$predictor_names), "Species")
    expect_equal(setdiff(names(iris), rf_iris_mat$predictor_names), "Species")
})

test_that("out-of-bag error estimate is number", {
    expect_true(hasName(rf_iris_df, 'oob_error'))
    expect_false(is.na(rf_iris_df$oob_error))
    expect_true(hasName(rf_iris_mat, 'oob_error'))
    expect_false(is.na(rf_iris_mat$oob_error))
})

test_that("can train when 'data' argument has more than one class", {
    dat <- iris
    class(dat) <- c("data.frame", "data.table")
    expect_silent(train(data=dat, response_name="Species"))
})

test_that("can train when response has attributes other than names", {
    iris2 <- iris
    attr(iris2$Sepal.Width, "aaa") <- "bbb"
    expect_silent(train(data=iris2, response_name="Sepal.Width"))
})

test_that("get error when predictor has missing values", {
    dat <- iris
    dat[25, "Sepal.Length"] <- NA
    expect_error(train(data=dat, response_name="Species"),
                 "Missing values in the predictors: Sepal.Length.", fixed=TRUE)
    dat_num <- iris
    dat_num[25, "Species"] <- NA
    expect_error(train(data=dat_num, response_name="Sepal.Length"),
                 "Missing values in the predictors: Species.", fixed=TRUE)
})

test_that("get error when response has missing values", {
    dat <- iris
    dat[4, "Species"] <- NA
    expect_error(train(data=dat, response_name="Species"),
                 "Missing values in the response.", fixed=TRUE)
    dat_num <- iris
    dat_num[4,"Sepal.Length"] <- NA_real_
    expect_error(train(data=dat_num, response_name="Sepal.Length"),
                 "Missing values in the response.", fixed=TRUE)
})

test_that("missing value allowed in discarded column", {
    dat <- iris
    dat[1, "Sepal.Width"] <- NA
    expect_silent(train(data=dat, response_name="Species",
                        predictor_names="Sepal.Length"))
})

test_that("can train when a predictor is named 'none'", {
    dat <- data.frame(y=rbinom(100, 1, .5),
                      x=rbinom(100, 1, .5),
                      none=rbinom(100, 1, .5))
    rf_df <- train(data=dat, response_name="y")
    rf_mat <- train(data=data.matrix(dat), response_name="y")
    expect_equal(rf_df$predictor_names, c("x", "none"))
    expect_equal(rf_mat$predictor_names, c("x", "none"))
})

test_that("get error when sample fraction is outside (0,1]", {
    expect_error(train(data=iris, response_name="Species", sample_fraction=0))
    expect_error(train(data=iris, response_name="Species",
                       sample_fraction=1 * (1 + .Machine$double.eps)))
})

test_that("can use function as 'n_try' argument ", {
    rf <- train(data=iris, response_name="Species", n_try=function(n) n - 1)
    expect_equal(3, rf$n_try)
})

test_that("get error when 'n_try' function has error", {
    expect_error(
        train(data=iris, response_name="Species",
              n_try=function(n) stop("this is some error")),
        "'n_try' function evaluation resulted in an error.",
        fixed=TRUE)
})

if (requireNamespace("tibble", quietly=TRUE)) tb <- tibble::as_tibble(iris)

test_that("can train with tibble", {
    skip_if_not_installed("tibble")
    expect_silent(train(data=tb, response_name="Species"))
    expect_silent(train(data=tb, response_name="Sepal.Length"))
})