tests/testthat/test_prep_num_bin.R

In gloverd2/admr: Contains standard functions for Admiral Advance Analytics

testthat::context("Testing prep_num_bin (numeric binning function)")


testthat::test_that("Testing numeric binning - Error checking - input",{

  # var_to_band must be numeric
  testthat::expect_error(prep_num_bin(var_to_band=rep("a",10), n_bins=5))
  testthat::expect_error(prep_num_bin(var_to_band=rep(c("a",1), each=5), n_bins=5))

  # var_to_band must be longer than n_bins
  testthat::expect_error(prep_num_bin(var_to_band=c(1,1), n_bins=5))
})

testthat::test_that("Testing numeric binning - Error checking - weights",{
  # Weight must be positive numeric of same length as var_to_band
  testthat::expect_error(prep_num_bin(var_to_band=1:100, weights = 1))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, weights = 1:99))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, weights = rep("a",100)))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, weights = -1:98))
})

testthat::test_that("Testing numeric binning - Error checking - binning param",{

  # n_bins must be positive whole number > 1
  testthat::expect_error(prep_num_bin(var_to_band=1:100, n_bins=NA))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, n_bins=-1))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, n_bins=1))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, n_bins=4.5))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, n_bins=c(10,10)))

  testthat::expect_error(prep_num_bin(var_to_band=1:100, method="bad"))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, use_labels="bad"))

  testthat::expect_error(prep_num_bin(var_to_band=1:100, method="gaussian_weight", mean=-1, sd=0.3))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, method="gaussian_weight", mean=2, sd=0.3))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, method="gaussian_weight", mean=0.5, sd=-1))
  testthat::expect_error(prep_num_bin(var_to_band=1:100, method="gaussian_weight", mean=0.5, sd=2))

  testthat::expect_error(prep_num_bin(var_to_band=1:100, n_bins=5, use_labels = "TRUE"))

})



testthat::test_that("Testing numeric binning",{

  #Even bins
  out_value1 <- prep_num_bin(var_to_band=1:20, n_bins=5)
  testthat::expect_equal(out_value1$bins, rep(1:5, each=4))
  testthat::expect_equal(out_value1$labels, c("[1 - 5)", "[5 - 9)", "[9 - 13)", "[13 - 17)", "[17 - 20)"))

  out_value2 <- prep_num_bin(var_to_band=1:20, n_bins=5, use_labels = TRUE)
  testthat::expect_equal(as.character(out_value2$bins), rep(c("[1 - 5)", "[5 - 9)", "[9 - 13)", "[13 - 17)", "[17 - 20)"), each=4))
  testthat::expect_equal(out_value2$labels, c("[1 - 5)", "[5 - 9)", "[9 - 13)", "[13 - 17)", "[17 - 20)"))

  #Gaussian bins
  out_value3 <- prep_num_bin(var_to_band=1:1000, n_bins=25, method="gaussian_weight")
  # Check each bucket is larger than the one nearer the edge
  for (ii in 1:12){
    testthat::expect_true(table(out_value3$bins)[[ii]] <= table(out_value3$bins)[[ii+1]])
    testthat::expect_true(table(out_value3$bins)[[25 - (ii-1)]] <= table(out_value3$bins)[[25 - ii]])
  }

  out_value4 <- prep_num_bin(var_to_band=1:1000, n_bins=25, method="gaussian_weight", mean=0, sd=0.5)
  # Check each bucket is larger than the one nearer the edge
  for (ii in 1:24){
    testthat::expect_true(table(out_value4$bins)[[ii]] >= table(out_value4$bins)[[ii+1]])
  }

  out_value5 <- prep_num_bin(var_to_band=1:1000, n_bins=25, method="gaussian_weight", mean=1, sd=0.5)
  # Check each bucket is larger than the one nearer the edge
  for (ii in 1:24){
    testthat::expect_true(table(out_value5$bins)[[ii]] <= table(out_value5$bins)[[ii+1]])
  }

  # Check it can deal with NAs
  out_value6 <- prep_num_bin(var_to_band=c(NA,1:1000), n_bins=25, method="gaussian_weight", mean=0, sd=0.5)
  testthat::expect_true(is.na(out_value6$bins[1]))

  #Check identical values aren't split
  out_value7 <- prep_num_bin(var_to_band=rep(1, 100), n_bins=25)
  testthat::expect_equal(out_value7$bins, rep(1, 100))

})