jared
2c7c9a6dbc
R-CMD-check / R CMD check (push) Successful in 4m17s
Blocking issue #1: Replace all ggplot2::function() calls with bare references in R/colors.R, R/logo.R, R/theme.R. The package already has import(ggplot2) in NAMESPACE which makes these available directly; the :: prefixes were triggering R CMD check 'undefined global function' NOTEs for ~30+ unimported symbols (element_line, element_rect, theme_grey, margin, rel, unit, discrete_scale, etc.). Suggestion #6: Replace class(x) == "character" with "character" %in% class(x) in R/db.R (countCleanr and simpleCap). The == pattern breaks on S3 objects with multiple class attributes. Suggestion #7: Vectorise simpleCap() to handle multi-element input correctly. Previously strsplit(x, ' ')[[1]] only processed the first element; now uses unname(vapply()) to capitalise each vector element independently while preserving the original scalar behaviour (no names attribute on output). Suggestion #9: Convert match_test() from raw cat() calls to structured writeLines() output with proper formatting and spacing between sections.
258 lines
8.2 KiB
R
258 lines
8.2 KiB
R
# Test utils
|
|
|
|
context("Test Utilities - Safe Max")
|
|
test_that("safe_max excludes NAs", {
|
|
samp_a <- c(1:10, NA)
|
|
expect_equal(safe_max(samp_a), 10)
|
|
expect_equal(safe_max(samp_a), max(samp_a, na.rm = TRUE))
|
|
expect_equal(safe_max(c("cat", "box", "dog")), "dog")
|
|
expect_equal(safe_max(c("cat", "box", "dog")), max(c("cat", "box", "dog"), na.rm = TRUE))
|
|
|
|
})
|
|
|
|
test_that("safe_max handles all NAs", {
|
|
expect_equal(safe_max(rep(NA, 100)), NA)
|
|
expect_equal(safe_max(NULL), NA)
|
|
|
|
})
|
|
|
|
context("Test Utilities - Pretty Per")
|
|
|
|
test_that("pretty_per respects rounding", {
|
|
expect_identical(pretty_per(0.2), "20.0%")
|
|
expect_identical(pretty_per(0.2432522), "24.3%")
|
|
expect_identical(pretty_per(0.2432522, ndigit = 3), "24.325%")
|
|
})
|
|
|
|
|
|
test_that("pretty_per handles NAs", {
|
|
expect_equivalent(pretty_per(rep(NA, 5)), c("-", "-", "-", "-", "-"))
|
|
|
|
})
|
|
|
|
test_that("pretty_per deals with large numbers", {
|
|
expect_message(pretty_per(c(0.2, 0.5, 0.1, 110)))
|
|
|
|
})
|
|
|
|
context("Test Utilities - NA Zero")
|
|
|
|
test_that("Function works when no NAs present", {
|
|
expect_equivalent(na_zero(1:10), 1:10)
|
|
expect_equivalent(na_zero(letters), letters)
|
|
|
|
})
|
|
|
|
test_that("Function subs out NAs in numeric vectors with 0", {
|
|
expect_equivalent(na_zero(c(1:10, NA)), c(1:10, 0))
|
|
})
|
|
|
|
# Test that na_sum works
|
|
test_that("NA Sum takes sum setting NA values to 0", {
|
|
expect_equivalent(na_sum(c(1:10, NA)), sum(1:10, 0))
|
|
expect_message(na_sum(c(1:10, NA)), "Taking a sum with missing values equal to 0, be careful!")
|
|
})
|
|
|
|
test_that("na_sum fails with non-numerics", {
|
|
expect_error(na_sum(LETTERS))
|
|
expect_error(na_sum(as.factor(1:10)))
|
|
})
|
|
|
|
test_that("na_sum quiet=TRUE suppresses the message", {
|
|
expect_message(na_sum(c(1:10, NA)), "Taking a sum")
|
|
expect_silent(na_sum(c(1:10, NA), quiet = TRUE))
|
|
expect_equal(na_sum(c(1:10, NA), quiet = TRUE), 55)
|
|
})
|
|
|
|
|
|
context("Test Utilities - Postcode Lookup")
|
|
|
|
# --- postcode_lookup -------------------------------------------------------
|
|
|
|
# Build a lookup that mirrors the internal implementation:
|
|
# state.name + "District of Columbia" + "Puerto Rico"
|
|
map_name <- c(state.name, "District of Columbia", "Puerto Rico")
|
|
map_abb <- c(state.abb, "DC", "PR")
|
|
|
|
lookup_ref <- function(x) {
|
|
map_abb[match(as.character(x), map_name)]
|
|
}
|
|
|
|
|
|
test_that("postcode_lookup returns correct abbreviations for known states", {
|
|
expect_equal(postcode_lookup("Montana"), lookup_ref("Montana"))
|
|
expect_equal(postcode_lookup("Texas"), lookup_ref("Texas"))
|
|
expect_equal(postcode_lookup("New York"), lookup_ref("New York"))
|
|
expect_equal(postcode_lookup("California"), lookup_ref("California"))
|
|
})
|
|
|
|
|
|
test_that("postcode_lookup handles DC and Puerto Rico", {
|
|
# These are not in state.name/state.abb but should still resolve.
|
|
expect_equal(postcode_lookup("District of Columbia"), "DC")
|
|
expect_equal(postcode_lookup("Puerto Rico"), "PR")
|
|
})
|
|
|
|
|
|
test_that("postcode_lookup is vectorized", {
|
|
states <- c("Montana", "Texas", "California", "Florida")
|
|
result <- postcode_lookup(states)
|
|
expected <- lookup_ref(states)
|
|
expect_equal(result, expected)
|
|
expect_length(result, length(states))
|
|
})
|
|
|
|
|
|
test_that("postcode_lookup returns NA for unknown state names", {
|
|
# match() returns NA when there is no match; the function propagates it.
|
|
result <- postcode_lookup("Atlantis")
|
|
expect_true(is.na(unname(result)))
|
|
})
|
|
|
|
|
|
test_that("postcode_lookup matches all built-in states", {
|
|
# Every entry in state.name should resolve to a valid abbreviation.
|
|
results <- postcode_lookup(state.name)
|
|
expected <- lookup_ref(state.name)
|
|
expect_equal(results, expected)
|
|
expect_false(any(is.na(results)))
|
|
})
|
|
|
|
|
|
context("Test Utilities - Race Short Names")
|
|
|
|
# --- race_short_names -------------------------------------------------------
|
|
|
|
# A reference implementation mirroring the function logic for cross-checking.
|
|
race_ref <- function(x) {
|
|
x <- as.character(x)
|
|
x[x %in% c("Black", "Black Or African American", "Black or African American",
|
|
"African American")] <- "black"
|
|
x[x %in% c("Hispanic", "Hispanic Or Latino", "Hispanic or Latino")] <- "hisp_lat"
|
|
x[x %in% c("White", "white", "White and Not Hispanic")] <- "white"
|
|
x[x %in% c("Asian", "Asian American")] <- "asian"
|
|
x[x %in% c("Two Or More Races", "Two or More Races")] <- "two_or_more"
|
|
x[x %in% c("Native Hawaiian Or Other Pacific Islander",
|
|
"Native Hawaiian or Other Pacific Islander",
|
|
"Native Hawaiian Pacific Islander")] <- "native_haw"
|
|
x[x %in% c("American Indian", "American Indian Or Alaska Native",
|
|
"American Indian or Alaska Native", "American Indian or Native Alaskan")] <- "amind"
|
|
x[x %in% c("Not Reported")] <- "other"
|
|
x
|
|
}
|
|
|
|
|
|
test_that("race_short_names returns character vector of same length", {
|
|
input <- c("Black", "Hispanic Or Latino", "White")
|
|
result <- race_short_names(input)
|
|
expect_type(result, "character")
|
|
expect_length(result, length(input))
|
|
})
|
|
|
|
|
|
test_that("race_short_names maps all known categories correctly", {
|
|
# One representative from each category group.
|
|
input <- c(
|
|
"Black Or African American",
|
|
"Hispanic or Latino",
|
|
"White and Not Hispanic",
|
|
"Asian American",
|
|
"Two or More Races",
|
|
"Native Hawaiian or Other Pacific Islander",
|
|
"American Indian or Alaska Native",
|
|
"Not Reported"
|
|
)
|
|
|
|
expected <- c(
|
|
"black", "hisp_lat", "white", "asian",
|
|
"two_or_more", "native_haw", "amind", "other"
|
|
)
|
|
|
|
result <- race_short_names(input)
|
|
expect_equal(result, expected)
|
|
})
|
|
|
|
|
|
test_that("race_short_names coerces factors to character", {
|
|
input_factor <- factor(c("Black", "White", "Asian"))
|
|
result <- race_short_names(input_factor)
|
|
expect_type(result, "character")
|
|
expect_equal(result, c("black", "white", "asian"))
|
|
})
|
|
|
|
|
|
test_that("race_short_names passes through unrecognized values unchanged", {
|
|
input <- c("Black", "Some Other Category", "White")
|
|
result <- race_short_names(input)
|
|
# Unrecognized category should be returned as-is (lowercased by as.character).
|
|
expect_equal(result[2], "Some Other Category")
|
|
})
|
|
|
|
|
|
test_that("race_short_names handles empty input", {
|
|
result <- race_short_names(character(0))
|
|
expect_length(result, 0)
|
|
expect_type(result, "character")
|
|
})
|
|
|
|
|
|
test_that("race_short_names matches reference implementation across all categories",
|
|
{
|
|
# Exhaustive check: feed every variant string the function handles.
|
|
all_variants <- c(
|
|
"Black", "Black Or African American", "Black or African American", "African American",
|
|
"Hispanic", "Hispanic Or Latino", "Hispanic or Latino",
|
|
"White", "white", "White and Not Hispanic",
|
|
"Asian", "Asian American",
|
|
"Two Or More Races", "Two or More Races",
|
|
"Native Hawaiian Or Other Pacific Islander",
|
|
"Native Hawaiian or Other Pacific Islander",
|
|
"Native Hawaiian Pacific Islander",
|
|
"American Indian", "American Indian Or Alaska Native",
|
|
"American Indian or Alaska Native", "American Indian or Native Alaskan",
|
|
"Not Reported"
|
|
)
|
|
|
|
expect_equal(race_short_names(all_variants), race_ref(all_variants))
|
|
})
|
|
|
|
|
|
context("Test Utilities - Get FIPS")
|
|
|
|
# --- get_fips ---------------------------------------------------------------
|
|
|
|
|
|
test_that("get_fips errors gracefully when tidycensus is not installed", {
|
|
# When tidycensus is absent, the function should stop with an informative message.
|
|
if (!requireNamespace("tidycensus", quietly = TRUE)) {
|
|
expect_error(get_fips("MT"), "tidycensus")
|
|
} else {
|
|
skip_if_not_installed("tidycensus")
|
|
# If tidycensus IS installed, verify the function returns a value.
|
|
result <- get_fips("MT")
|
|
expect_type(result, "character")
|
|
expect_gt(length(result), 0)
|
|
}
|
|
})
|
|
|
|
|
|
test_that("get_fips returns a FIPS code for a valid state abbreviation", {
|
|
skip_if_not_installed("tidycensus")
|
|
result <- get_fips("MT")
|
|
# Montana's FIPS state code is "30"
|
|
expect_equal(result, "30")
|
|
})
|
|
|
|
|
|
test_that("get_stabbr returns a valid abbreviation", {
|
|
skip_if_not_installed("tidycensus")
|
|
result <- get_fips("CA")
|
|
# California's FIPS state code is "06"
|
|
expect_equal(result, "06")
|
|
})
|
|
|
|
|
|
context("Test Utilities - Pretty Count")
|
|
|
|
|