tests/testthat/test_utilityfunctions.R

In awstringer/innR2binnR: Advanced Variable Discretization

require(modellingTools, quietly = TRUE,warn.conflicts = FALSE)
require(innR2binnR, quietly = TRUE,warn.conflicts = FALSE)
require(stringr, quietly = TRUE,warn.conflicts = FALSE)


context("Utility Functions")


### merge_levels

x <- factor(1:10)
y <- modellingTools::vector_bin(1:10,bins = c(1,3,5,7,9,10))

xm <- merge_levels(x,c(1,2,3))
ym <- merge_levels(y,c("[1,3]","[3,5]"))

xmn <- merge_levels(x,c(1,2,3),merge_names = TRUE)
ymn <- merge_levels(y,c("[1,3]","[3,5]"),merge_names = TRUE)

test_that("merge_levels throws appropriate errors", {
  expect_error(merge_levels(x,"3"))
  expect_error(merge_levels(1:10,c("3,4,5")))

  expect_error(merge_levels(x,c(-3,-2)),
               regexp = "None.")
  expect_warning(merge_levels(x,c(1,2,-3,-4)),
                 regexp = stringr::str_c("The following level is not present in",
                                         " supplied variable: -3"))
})

test_that("levels of the output are as expected", {
  expect_true(all(levels(xm) %in% c("1x2x3",4:10)))
  expect_true(all(c("1x2x3",4:10) %in% levels(xm)))

  expect_true(all(levels(xmn) %in% c("[1,3]",4:10)))
  expect_true(all(c("[1,3]",4:10) %in% levels(xmn)))

  expect_true(all(levels(ym) %in% c("[1,3]x[3,5]","[5,7]","[7,9]","[9,10]")))
  expect_true(all(c("[1,3]x[3,5]","[5,7]","[7,9]","[9,10]") %in% levels(ym)))

  expect_true(all(levels(ymn) %in% c("[1,5]","[5,7]","[7,9]","[9,10]")))
  expect_true(all(c("[1,5]","[5,7]","[7,9]","[9,10]") %in% levels(ymn)))
})

test_that("datapoints are assigned to the correct new levels", {
  expect_identical(which(x %in% c(1,2,3)),
                   which(xm == "1x2x3"))
  expect_identical(which(x %in% c(1,2,3)),
                   which(xmn == "[1,3]"))

  expect_identical(which(y %in% c("[1,3]","[3,5]")),
                   which(ym == "[1,3]x[3,5]"))
  expect_identical(which(y %in% c("[1,3]","[3,5]")),
                   which(ymn == "[1,5]"))
})