tests/testthat/test-additivity.R

In ICEbox: Individual Conditional Expectation Plot Toolbox

context("additivity")

test_that("backfitter works with lm", {
  set.seed(123)
  n <- 50
  X <- data.frame(x1 = seq(0, 1, length.out = n), x2 = rnorm(n))
  y <- 2 * X$x1 + 3 * X$x2 + rnorm(n, sd = 0.1)
  
  fitMethod <- function(X, y) {
    lm(y ~ ., data = as.data.frame(X))
  }
  predictfcn <- function(object, newdata) {
    predict(object, as.data.frame(newdata))
  }
  
  bf <- backfitter(X, y, predictor = "x1", fitMethod = fitMethod, predictfcn = predictfcn, verbose = FALSE)
  
  expect_s3_class(bf, "backfitter")
  expect_equal(length(bf$g1_of_Xs), n)
  expect_equal(length(bf$g2_of_Xc), n)
  expect_true(bf$delta < 0.1)
})

test_that("additivityLineup works", {
  set.seed(123)
  n <- 30
  X <- data.frame(x1 = seq(0, 1, length.out = n), x2 = rnorm(n))
  y <- X$x1 + X$x2 + rnorm(n, sd = 0.1)
  
  fitMethod <- function(X, y) {
    lm(y ~ ., data = as.data.frame(X))
  }
  predictfcn <- function(object, newdata) {
    predict(object, as.data.frame(newdata))
  }
  
  bf <- backfitter(X, y, predictor = "x1", fitMethod = fitMethod, predictfcn = predictfcn, verbose = FALSE)
  
  mod <- fitMethod(X, y)
  # ice() arguments: object, X, y, predictor
  realICE <- ice(object = mod, X = X, y = y, predictor = "x1", verbose = FALSE)
  
  pdf(NULL)
  on.exit(invisible(dev.off()))
  al <- additivityLineup(bf, fitMethod, realICE, figs = 4)
  
  expect_s3_class(al, "additivityLineup")
  expect_equal(length(al$null_ices), 3)
  expect_true(al$location >= 1 && al$location <= 4)
  expect_equal(length(al$plots), 4)
})

test_that("backfitter handles character predictor", {
  set.seed(123)
  n <- 50
  X <- data.frame(feat1 = seq(0, 1, length.out = n), feat2 = rnorm(n))
  y <- 2 * X$feat1 + 3 * X$feat2 + rnorm(n, sd = 0.1)
  
  fitMethod <- function(X, y) {
    lm(y ~ ., data = as.data.frame(X))
  }
  predictfcn <- function(object, newdata) {
    predict(object, as.data.frame(newdata))
  }
  
  bf <- backfitter(X, y, predictor = "feat1", fitMethod = fitMethod, predictfcn = predictfcn, verbose = FALSE)
  expect_equal(bf$predictor, "feat1")
})

test_that("additivityLineup works with colorvecfcn", {
  set.seed(123)
  n <- 30
  X <- data.frame(x1 = seq(0, 1, length.out = n), x2 = rnorm(n))
  y <- X$x1 + X$x2 + rnorm(n, sd = 0.1)
  
  fitMethod <- function(X, y) lm(y ~ ., data = as.data.frame(X))
  predictfcn <- function(object, newdata) predict(object, as.data.frame(newdata))
  
  bf <- backfitter(X, y, predictor = "x1", fitMethod = fitMethod, predictfcn = predictfcn, verbose = FALSE)
  mod <- fitMethod(X, y)
  realICE <- ice(mod, X, y, predictor = "x1", verbose = FALSE)
  
  color_fcn <- function(ice_obj) {
    rep("red", nrow(ice_obj$ice_curves))
  }
  
  pdf(NULL)
  on.exit(invisible(dev.off()))
  al <- additivityLineup(bf, fitMethod, realICE, figs = 2, colorvecfcn = color_fcn, usecolorvecfcn_inreal = TRUE)
  
  expect_s3_class(al, "additivityLineup")
  expect_equal(length(al$plots), 2)
})