test(census_geo_api): update tests

kosukeimai · Apr 4, 2024 · f1907d9 · f1907d9
1 parent df41622
commit f1907d9
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 52 deletions.
diff --git a/tests/testthat/test-census_helper_v2.R b/tests/testthat/test-census_helper_v2.R
@@ -47,10 +47,10 @@ test_that("helper returns verified census tract data",{
     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)
+  expect_equal(x[x$surname == "Lopez", "r_whi"], 0.767197, tolerance = 0.000001)
+  expect_equal(x[x$surname == "Khanna", "r_whi"], 0.708026, tolerance = 0.000001)
+  expect_equal(x[x$surname == "Lopez", "r_bla"], 0.09522743, tolerance = 0.000001)
+  expect_equal(x[x$surname == "Khanna", "r_bla"], 0.09544469, tolerance = 0.000001)
 })
 
 skip_if_not(nzchar(Sys.getenv("CENSUS_API_KEY")))
@@ -88,4 +88,4 @@ test_that("New tables and legacy tables return equal race predictions",{
   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)
-  })
+})
diff --git a/tests/testthat/test-rollup.R b/tests/testthat/test-rollup.R
@@ -51,11 +51,12 @@ if(Sys.getenv("CENSUS_API_KEY") != "") {
         sum_oth = sum(r_oth)
       )
 
-    expect_true(all(apply(
-      r$DE$block[, c('r_whi', 'r_bla', 'r_his', 'r_asi', 'r_oth')],
-      2,
-      sum
-    ) == 1))
+    expect_true(
+      all.equal(
+        colSums(r$DE$block[, c('r_whi', 'r_bla', 'r_his', 'r_asi', 'r_oth')]),
+        c('r_whi' = 1, 'r_bla' = 1, 'r_his' = 1, 'r_asi' = 1, 'r_oth' = 1)
+      )
+    )
     expect_equal(r_county_from_tract, r_county_level, tolerance = 1e-7)
     expect_equal(r_tract_level, r_tract_from_block, tolerance = 1e-7)
   })
@@ -69,16 +70,19 @@ if(Sys.getenv("CENSUS_API_KEY") != "") {
     ))
 
     r_sum_from_block <- r$WY$block |>
-      select(P12I_001N:P12G_001N) |>
-      apply(2, sum)
+      dplyr::select(-state, -county, -tract, -block, -dplyr::starts_with("r_")) |>
+      colSums()
 
     r_sum_from_tract <- r$WY$tract |>
-      select(P12I_001N:P12G_001N) |>
-      apply(2, sum)
+      dplyr::select(-state, -county, -tract, -dplyr::starts_with("r_")) |>
+      colSums()
 
     r_sum_from_county <- r$WY$county  |>
-      select(P12I_001N:P12G_001N) |>
-      apply(2, sum)
+      dplyr::select(-state, -county, -dplyr::starts_with("r_")) |>
+      colSums()
+
+    expect_equal(r_sum_from_block, r_sum_from_tract)
+    expect_equal(r_sum_from_block, r_sum_from_county)
 
     r_zcta_level <- suppressMessages(get_census_data(
       key = NULL,
@@ -87,17 +91,10 @@ if(Sys.getenv("CENSUS_API_KEY") != "") {
     ))
 
     r_sum_from_zcta <- r_zcta_level$WY$zcta |>
-      select(P12I_001N:P12G_001N) |>
-      apply(2, sum)
+      dplyr::select(-state, -zcta, -dplyr::starts_with("r_")) |>
+      colSums()
 
-    expect_true(
-      all.equal(
-        r_sum_from_block,
-        r_sum_from_tract,
-        r_sum_from_county,
-        r_sum_from_zcta
-      )
-    )
+    expect_equal(r_sum_from_block, r_sum_from_zcta, tolerance = 0.001)
   })
 
   test_that('Roll-ups for ZIP and county race sum to same for state', {
@@ -114,15 +111,13 @@ if(Sys.getenv("CENSUS_API_KEY") != "") {
     ))
 
     expect_equal(
-      apply(r_zcta_level$RI$zcta |>
-              select(P12I_001N:P12G_001N),
-            2,
-            sum),
-      apply(r_county_level$RI$county |>
-              select(P12I_001N:P12G_001N),
-            2,
-            sum),
-      tolerance = 1
+      r_zcta_level$RI$zcta |>
+        dplyr::select(-state, -zcta, -dplyr::starts_with("r_")) |>
+        colSums(),
+      r_county_level$RI$county |>
+        dplyr::select(-state, -county, -dplyr::starts_with("r_")) |>
+        colSums(),
+      tolerance = 0.001
     )
   })
 
@@ -138,16 +133,19 @@ if(Sys.getenv("CENSUS_API_KEY") != "") {
     ))
 
     r_sum_from_block <- r$AK$block |>
-      dplyr::select(r_whi:r_fem_23_oth) |>
-      apply(2, sum)
+      dplyr::select(dplyr::starts_with("r_")) |>
+      colSums()
 
     r_sum_from_tract <- r$AK$tract |>
-      dplyr::select(r_whi:r_fem_23_oth) |>
-      apply(2, sum)
+      dplyr::select(dplyr::starts_with("r_")) |>
+      colSums()
 
-    r_sum_from_county <- r$AK$county  |>
-      dplyr::select(r_whi:r_fem_23_oth) |>
-      apply(2, sum)
+    r_sum_from_county <- r$AK$county |>
+      dplyr::select(dplyr::starts_with("r_")) |>
+      colSums()
+
+    expect_equal(r_sum_from_block, r_sum_from_tract)
+    expect_equal(r_sum_from_block, r_sum_from_county)
 
     r_zcta_level <- suppressMessages(get_census_data(
       key = NULL,
@@ -158,16 +156,9 @@ if(Sys.getenv("CENSUS_API_KEY") != "") {
     ))
 
     r_sum_from_zcta <- r_zcta_level$AK$zcta |>
-      dplyr::select(r_whi:r_fem_23_oth) |>
-      apply(2, sum)
+      dplyr::select(dplyr::starts_with("r_")) |>
+      colSums()
 
-    expect_true(
-      all.equal(
-        r_sum_from_block,
-        r_sum_from_tract,
-        r_sum_from_county,
-        r_sum_from_zcta
-      )
-    )
+    expect_equal(r_sum_from_block, r_sum_from_zcta, tolerance = 0.001)
   })
 }