tests/testthat/test-utils.R

In jknowles/eeptools: Convenience Functions for Education Data

# Test utils
context("Test defac conversion of factors")

test_that("defac works for all types of factors", {
  a <- as.factor(LETTERS)
  b <- ordered(c(1, 3, '09', 7, 5, "B"))
  expect_is(defac(a), "character")
  expect_is(defac(b), "character")
  a2 <- defac(a)
  b2 <- defac(b)
  expect_identical(levels(a), a2)
  expect_true(all(levels(b) %in% b2))
  expect_identical(length(a), length(a2))
  expect_identical(length(b), length(b2))
})

context("Forcing numerics with makenum")

test_that("makenum works for all types of factors", {
  a <- ordered(c(1, 3, '09', 7, 5))
  a2 <- makenum(a)
  b <- factor(c(1, 3, '09', 7, 5))
  b2 <- makenum(b)
  c <- factor(c(1, 3, '09', 7, 5, "B"))
  c2 <- makenum(c)
  expect_is(a2, "numeric")
  expect_is(b2, "numeric")
  expect_is(c2, "numeric")
  expect_identical(length(a), length(a2))
  expect_identical(length(b), length(b2))
  expect_identical(length(c), length(c2))
  expect_identical(a2, b2)
  expect_identical(c2[6], NA_real_)
})

context("Test that cutoff is numerically accurate")

test_that("cutoff gets the desired result", {
  set.seed(1024)
  a <- rnorm(1000, mean = 0, sd = 1)
  b <- rlnorm(1000, meanlog = 2, sdlog = 1)
  expect_equal(cutoff(a, .05), 0)
  expect_equal(cutoff(a, 0.5), 2)
  expect_equal(cutoff(b, .8), 427)
  
  d <- b
  d[400:500] <- NA
  expect_equal(cutoff(d, 0.2), 131)
  expect_equal(cutoff(d, 0.9, na.rm=FALSE), NA)
  expect_equal(cutoff(d, 0.2, na.rm=FALSE), NA)
  expect_equal(cutoff(d, 0.9, na.rm=TRUE), 648)
  expect_equal(cutoff(d, 0.2, na.rm=TRUE), 131)
  expect_error(cutoff(d, 39))
  expect_error(cutoff(d, -39))
  expect_error(cutoff(d, -0.00039))
})

context("Test the threshold function for numeric accuracy")


test_that("thresh gets the accurate result", {
  set.seed(1024)
  a <- rnorm(1000, mean = 0, sd = 1)
  b <- rlnorm(1000, meanlog = 2, sdlog = 1)
  expect_error(thresh(a, 0))
  expect_equal(thresh(a, 2), 0.5, tol = 0.03, scale = 1)
  expect_equal(thresh(b, 427), 0.8, tol = 0.01)
  
  d <- b
  d[400:500] <- NA
  expect_equal(thresh(d, 131), 0.48, tol = 0.01)
  expect_equal(thresh(d, 648, na.rm=FALSE), NA)
  expect_equal(thresh(d, 131, na.rm=FALSE), NA)
  expect_equal(thresh(d, 600, na.rm=TRUE), 0.92, tol = 0.005)
  expect_equal(thresh(d, 131, na.rm=TRUE), 0.48, tol = 0.01)
  expect_error(thresh(d, 0.39))
  expect_error(thresh(d, -0.39))
  expect_error(thresh(d, -39))
})

context("Test that max_mis works correctly")

test_that("max_mis handles missing data correctly", {
  expect_identical(max(c(7,NA,3,2,0),na.rm=TRUE), max_mis(c(7,NA,3,2,0)))
  max(c(NA,NA,NA,NA),na.rm=TRUE)
  expect_identical(max_mis(c(NA,NA,NA,NA)), NA_real_)
  expect_identical(max_mis(c(NA_real_, NA_real_)), NA_real_)
  expect_identical(max_mis(vector(mode = 'integer')), NA_integer_)
  expect_identical(max_mis(c()), NA_real_)
  expect_error(max_mis(c("A", "B", "C")))
  expect_error(max_mis(factor("A", "B", "C")))
  expect_error(max_mis(ordered("A", "B", "C")))
})

context("Remove character")

test_that("Remove character works for multiple character type", {
  a <- c(1, 5, 3, 6, "*", 2, 5, "*", "*")
  b <- remove_char(a, "*")
  expect_is(b, "character")
  expect_identical(length(a), length(b))
  expect_equal(length(b[is.na(b)]), 3)
  a <- c(1, 3, 5, "B", "D", ".", ".", ".")
  b <- remove_char(a, ".")
  expect_is(b, "character")
  expect_identical(length(a), length(b))
  expect_equal(length(b[is.na(b)]), 3)
  a <- c(1, 3, 5, "B", "D", "Unk.", "Unk.", "Unk.")
  b <- remove_char(a, "Unk.")
  expect_is(b, "character")
  expect_identical(length(a), length(b))
  expect_equal(length(b[is.na(b)]), 3)
  a <- c(1, 3, 5, "B", "D", "Unk.", "Unk.", "Unk.", NA, NA, NA)
  b <- remove_char(a, "Unk.")
  expect_is(b, "character")
  expect_identical(length(a), length(b))
  expect_equal(length(b[is.na(b)]), 6)
})


context("Leading zero functions as desired")

test_that("Function works for multiple types of inputs", {
  a <- seq(1, 9)
  a2 <- leading_zero(a, digits = 2)
  expect_is(a2, "character")
  expect_true(all(sapply(a2, nchar)==2))
  expect_error(leading_zero(a2, digits = -1))
  expect_error(leading_zero(a2, digits = 0))
  expect_identical(leading_zero(a, digits = -1), leading_zero(a, digits = 0))
  
  a <- seq(9, 25)
  a2 <- leading_zero(a, digits = 3)
  expect_is(a2, "character")
  expect_true(all(sapply(a2, nchar)==3))
  a2 <- leading_zero(a, digits = 1)
  expect_false(all(sapply(a2, nchar)==1))
  
  expect_error(leading_zero(c("A", "B", "C", digits = 2)))
  a <- c(-5000, -50, -5, -.01, 0, 0.1, 4, 40, 400, 4000)
  a2 <- leading_zero(a, digits = 3)
  expect_identical(a2, c("-5000", "-050", "-005", "0000", "0000", "0000", 
                         "0004", "0040", 
                         "0400", "4000"))
})

context("Test decomma")

a <- c("12,124", "21,131", "A,b")
b <- c("12124", "21131", "Ab")

c <- a[1:2]
d <- as.numeric(b[1:2])

test_that("decomma returns the right class", {
  expect_that(decomma(c), equals(d))
  expect_that(decomma(a), gives_warning())
  expect_that(decomma(a), is_a("numeric"))
  expect_that(decomma(b), is_a("numeric"))
  expect_that(decomma(c), is_a("numeric"))
  expect_that(decomma(d), is_a("numeric"))
})

n <- c(NA, NA, NA, "7,102", "27,125", "23,325,22", "Ab")

test_that("decomma handles NAs properly", {
  expect_that(length(decomma(n)[!is.na(decomma(n))]), equals(3))
  expect_that(decomma(n)[6], equals(2332522))
})


context("nth max")

test_that("Numeric accuracy", {
  a <- c(1:20, 20:1)
  b <- c(LETTERS[c(2, 9, 3, 12, 1)])
  z <- c(121253125, 12401892377905, 31221, 12, 45, -2145125, -123, 0)
  f <- c(10, 10, 10, 10, 9, 9, 10.0001, 10.0001)
  expect_error(nth_max(a, 100), "index .* outside bounds")
  expect_error(nth_max(a, -1), "index .* outside bounds")
  expect_equal(nth_max(a), 20)
  expect_equal(nth_max(b, 3), "C")
  expect_equal(nth_max(z), 12401892377905)
  expect_equal(nth_max(f), 10.0001)
})

context("Test isid")

test_that("ISID returns correct values", {
  data(stuatt)
  total <- nrow(stuatt)
  expect_false(isid(stuatt, vars = c("sid")))
  expect_false(isid(stuatt, vars = c("sid", "school_year")))
  expect_output(isid(stuatt, vars = c("sid", "school_year"), verbose = TRUE))
  expect_output(isid(stuatt, 
                   vars = c("sid", "school_year", "male", 
                            "race_ethnicity", "hs_diploma_type"), verbose=TRUE))
  expect_true(isid(stuatt, 
                   vars = c("sid", "school_year", "male", 
                            "race_ethnicity", "hs_diploma_type")))
  
})