tests/testthat/test_expl_cond_dist_tbl.R

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

testthat::context("Testing test_expl_cond_dist_tbl")

testthat::test_that("Testing properties",{

  # Working example
  prop_df <- data.frame(main_var = c("1","2","3"), X1 = c(80,0,20), X2 = c(25,75,0))
  colnames(prop_df) <- c("main_var",1,2)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1,2,1,1,1,3,2,2), cond_var = c(1,1,2,2,1,1,1,2,2),output_var = "prop"), prop_df)

  # Testing output_var
  thin_df <- data.frame(main_var = c(1,1,2), cond_var = c(1,2,1), n = c(3L,1L,1L), total = c(4L,1L,4L), prop = c(75,100,25))
  row.names(thin_df) <- c(1L,2L,3L)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1,1,2,1), cond_var = c(1,1,1,1,2), output_var = "thin"), thin_df)

  count_df <- data.frame(main_var = c(1,2), X1 = c(3,1), X2 = c(1,0))
  colnames(count_df) <- c("main_var",1,2)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1,1,2,1), cond_var = c(1,1,1,1,2), output_var = "count"), count_df)

  prop_df <- data.frame(main_var = c(1,2), X1 = c(75,25), X2 = c(100,0))
  colnames(prop_df) <- c("main_var",1,2)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1,1,2,1), cond_var = c(1,1,1,1,2), output_var = "prop"), prop_df)

  # Can handle NAs in either main_var or cond_var.
  na_main_test_df <- data.frame(main_var = c("_NA","1"), X1 = c(25, 75))
  colnames(na_main_test_df) <- c("main_var",1) # Warning of 1 new _NA.
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(NA,1,1,1), cond_var = c(1,1,1,1), output_var = "prop"), na_main_test_df)

  na_cond_test_df <- data.frame(main_var = c(1), X1 = c(100), X2 = c(100))
  colnames(na_cond_test_df) <- c("main_var","_NA",1) # Warning of 1 new _NA
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1,1,1), cond_var = c(NA,1,1,1), output_var = "prop"), na_cond_test_df)

  # Gives a warning of how many values are pre-existing when assigning NAs.
  warn_pre_main_df <- data.frame(main_var = c("_NA","1","2"), X1 = c(50,25,25))
  colnames(warn_pre_main_df) <- c("main_var",1) # Warning of 1 new _NA and 1 pre-existing _NA in main_var.
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(NA,"_NA","1","2"), cond_var = c(1,1,1,1), output_var = "prop"), warn_pre_main_df)

  warn_pre_cond_df <- data.frame(main_var = c(1), X1 = c(100), X2 = c(100))
  colnames(warn_pre_cond_df) <- c("main_var","_NA",1) # Warning of 1 new _NA and 1 pre-existing _NA in cond_var.
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1,1), cond_var = c(NA,"_NA",1), output_var = "prop"), warn_pre_cond_df)

  all_warns_df <- data.frame(main_var = c("_NA","1"), X1 = c(75, 25), X2 = c(100,0), X3 = c(50,50))
  colnames(all_warns_df) <- c("main_var","_NA","1","2")
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,NA,NA,"_NA","_NA",NA,1), cond_var = c(NA,"_NA",1,2,NA,NA,2), output_var = "prop"), all_warns_df)

  # Works with infinite values.
  inf_df <- data.frame(main_var = c(-Inf,Inf), X1 = c(100,0), X2 = c(0, 100))
  colnames(inf_df) <- c("main_var", -Inf, Inf)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(-Inf, Inf), cond_var = c(-Inf, Inf), output_var = "prop"), inf_df)

  # Works with negative values.
  neg_df <- data.frame(main_var = c(-2,-1,1,2), X1 = c(0,0,1,0), X2 = c(1,1,0,0), X3 = c(0,0,0,1), X4 = c(1,0,1,0), X5 = c(0,1,0,0))
  colnames(neg_df) <- c("main_var",-4,-3,1,2,5)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(-1,1,2,1,-1,-2,-2), cond_var = c(-3,-4,1,2,5,-3,2), output_var = "count"),neg_df)

  # Works with non-integer values.
  non_int_df <- data.frame(main_var = c(-0.7, -0.5, 0, 0.3), X1 = c(0,1,0,0), X2 = c(0,0,1,0), X3 = c(0,0,0,1), X4 = c(1,0,0,0))
  colnames(non_int_df) <- c("main_var",-1.7,-0.5,-0.3,1.7)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(-0.5,-0.7,0,0.3), cond_var = c(-1.7,1.7,-0.5,-0.3), output_var = "count"),non_int_df)

  # Works with characters.
  char_df <- data.frame(main_var = c("A",1), X1 = c(2, 2), X2 = c(0, 1))
  colnames(char_df) <- c("main_var", "A", 1)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c("A","A",1,1,1), cond_var = c("A","A","A","A",1), output_var = "count"),char_df)

  # Testing the boundary of warn_high_band
  expl_cond_dist_tbl(main_var = 1:50, cond_var = rep(1,50), err_high_band = 100, output_var = "count") # Gives warning
  expl_cond_dist_tbl(main_var = 1:49, cond_var = rep(1,49), err_high_band = 100, output_var = "count")
  expl_cond_dist_tbl(main_var = rep(1,50), cond_var = 1:50, err_high_band = 100, output_var = "count") # Gives warning
  expl_cond_dist_tbl(main_var = rep(1,49), cond_var = 1:49, err_high_band = 100, output_var = "count")

  # Testing the boundary of err_high_band.
  testthat::expect_error(expl_cond_dist_tbl(main_var = 1:100, cond_var = rep(1,100), err_high_band = 100, output_var = "count")) # Error and warning
  expl_cond_dist_tbl(main_var = 1:99, cond_var = rep(1,99), err_high_band = 100, output_var = "count") # Gives warning
  testthat::expect_error(expl_cond_dist_tbl(main_var = rep(1,100), cond_var = 1:100, err_high_band = 100, output_var = "count")) # Error and warning
  expl_cond_dist_tbl(main_var = rep(1,99), cond_var = 1:99, err_high_band = 100, output_var = "count") # Gives warning
})


testthat::test_that("Test errors when input is invalid",{

  # Testing err_high_band
  testthat::expect_error(expl_cond_dist_tbl(main_var = 1:101, cond_var = c(rep(1:50,2),101), output_var = "count"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(rep(1:50,2),101), cond_var = 1:101, output_var = "count"))

  # NULL inputs
  testthat::expect_error(expl_cond_dist_tbl(main_var = NULL, cond_var = c(1,1), output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = NULL, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), NA_val = NULL, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), output_var = NULL))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), warn_high_band = NULL, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), err_high_band = NULL, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), verbose = NULL, output_var = "prop"))

  # Error testing output_var
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), output_var = "cat"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), output_var = -1))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), output_var = 0.1))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), output_var = NA))

  # It does however pass with upper case.
  basic_df <- data.frame(main_var = c(1), X1 = c(100))
  colnames(basic_df) <- c("main_var",1)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), output_var = "PROP"),basic_df)

  # Banding variables
  # Error condition for a banding of 1.
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), warn_high_band = 1, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), err_high_band = 1, output_var = "prop"))

  # No negatives
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), warn_high_band = -1, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), err_high_band = -1, output_var = "prop"))

  # No non-integers
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), warn_high_band = 1.2, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), err_high_band = 1.2, output_var = "prop"))

  # No characters
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), warn_high_band = "A", output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), err_high_band = "A", output_var = "prop"))

  # No NAs
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), warn_high_band = NA, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), err_high_band = NA, output_var = "prop"))

  # This does not currently accept Inf. Use a very large number as a substitute.
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), warn_high_band = Inf, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), err_high_band = Inf, output_var = "prop"))

  # Testing verbose
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), verbose = "TEST", output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), verbose = 2, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), verbose = NA, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), verbose = -1, output_var = "prop"))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1), cond_var = c(1,1), verbose = Inf, output_var = "prop"))

  # Different lengths
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1,2,1), cond_var = c(1,1,2)))
  testthat::expect_error(expl_cond_dist_tbl(main_var = c(1,1,2), cond_var = c(1,1,2,2)))
})

testthat::test_that("Examples:",{
  prop_df <- data.frame(main_var = c(1,2), X1 = c(75,25), X2 = c(100,0))
  colnames(prop_df) <- c("main_var",1,2)
  testthat::expect_equal(expl_cond_dist_tbl(main_var = c(1,1,1,2,1), cond_var = c(1,1,1,1,2),output_var = "prop"), prop_df)
})