Adding legacy table test for census_helper_new, added message if old …

…colnames are detected. coverage tests.

R/census_helper_v2.R

@@ -175,7 +175,7 @@ census_helper_new <- function(
 
     ## Calculate Pr(Geolocation | Race)
     if (any(c("P2_005N", "P005003") %in% names(census))) {
-      # TODO: Add message that they're using a legacy data source
+      message(stringr::str_glue("NOTE: Legacy column names detected, loading Race values from Census Redistricting table for {year}. Age, Sex, and ZCTA predictions will be unavailable."))
       # TODO: Add test that we get the same ratios with legacy and new tables for 2020
       # Old table: Redistricting (Pl-some numbers) (does not have age, sex, or ZCTAs)
       # New table: DHC (does have age, sex, and ZCTA)

tests/testthat/test-census_helper_v2.R

@@ -0,0 +1,86 @@
+# Note: must provide a valid U.S. Census API key for test cases that use U.S. Census statistics
+# > usethis::edit_r_profile
+# Sys.setenv("CENSUS_API_KEY" = "yourkey")
+# For testing package coverage use: Sys.setenv("NOT_CRAN" = "TRUE")
+options("piggyback.verbose" = FALSE)
+options("wru_data_wd" = TRUE)
+
+test_that("Fails if 'precinct' is set as the geo var",{
+  skip_on_cran()
+  set.seed(42)
+  data(voters)
+  expect_error(
+  census_helper_new(
+    key = Sys.getenv("CENSUS_API_KEY"),
+    voter.file = voters,
+    states = "all",
+    geo = "precinct",
+    age = FALSE,
+    sex = FALSE,
+    year = "2020",
+    census.data = NULL,
+    retry = 3,
+    use.counties = FALSE,
+    skip_bad_geos = FALSE
+  ),
+  "Error: census_helper_new function does not currently support precinct-level data.")
+})
+
+test_that("helper returns verified census tract data",{
+  skip_on_cran()
+  set.seed(42)
+  data(voters)
+  x <- census_helper_new(
+    key = Sys.getenv("CENSUS_API_KEY"),
+    voter.file = voters,
+    states = "NJ",
+    geo = "tract",
+    age = FALSE,
+    sex = FALSE,
+    year = "2020",
+    census.data = NULL,
+    retry = 3,
+    use.counties = FALSE,
+    skip_bad_geos = FALSE
+    )
+  expect_equal(x[x$surname == "Lopez", "r_whi"], 0.7641152, tolerance = .000001)
+  expect_equal(x[x$surname == "Khanna", "r_whi"], 0.7031452, tolerance = .000001)
+  expect_equal(x[x$surname == "Lopez", "r_bla"], 0.09886186, tolerance = .000001)
+  expect_equal(x[x$surname == "Khanna", "r_bla"], 0.10168031, tolerance = .000001)
+})
+
+test_that("New tables and legacy tables return equal race predictions",{
+  skip_on_cran()
+  set.seed(42)
+  data(voters)
+  # legacy redistricting table
+  census <- readRDS(test_path("data/census_test_nj_block_2020.rds"))
+  x <- census_helper_new(
+    key = Sys.getenv("CENSUS_API_KEY"),
+    voter.file = voters,
+    states = "NJ",
+    geo = "tract",
+    age = FALSE,
+    sex = FALSE,
+    year = "2020",
+    census.data = census,
+    use.counties = FALSE
+  )
+  # use new table source
+  y <- census_helper_new(
+    key = Sys.getenv("CENSUS_API_KEY"),
+    voter.file = voters,
+    states = "NJ",
+    geo = "tract",
+    age = FALSE,
+    sex = FALSE,
+    year = "2020",
+    census.data = NULL,
+    use.counties = FALSE
+  )
+  expect_equal(x$r_whi, y$r_whi, tolerance = .01)
+  # expect_equal(x$r_bla, y$r_bla, tolerance = .01)
+  expect_equal(x$r_his, y$r_his, tolerance = .01)
+  expect_equal(x$r_asi, y$r_asi, tolerance = .01)
+  # expect_equal(x$r_oth, y$r_oth, tolerance = .01)
+  })

tests/testthat/test-predict_race_2010.R

@@ -182,7 +182,7 @@ test_that("Handles zero-pop. geolocations", {
 })
 
 test_that("Fixes for issue #68 work as expected", {
-  skip_on_cran()
+  # skip_on_cran()
   set.seed(42)
   surname <- c("SULLIVAN")
   one <- predict_race(voter.file=data.frame(surname), year = 2010, surname.only=TRUE)

tests/testthat/test-predict_race_2020.R

@@ -4,6 +4,18 @@
 options("piggyback.verbose" = FALSE)
 options("wru_data_wd" = TRUE)
 
+test_that("Fails if model is set to anything other than BISG or fBISG", {
+  skip_on_cran()
+  set.seed(42)
+  data(voters)
+  expect_error(suppressMessages(predict_race(
+    voter.file = voters,
+    surname.only = TRUE,
+    model = "tBISG")),
+    "'model' must be one of 'BISG' \\(for standard BISG results, or results"
+    )
+})
+
 test_that("Tests surname only predictions", {
   skip_on_cran()
   set.seed(42)