new test and bug fix for samp_by_grp

harvard-ufds · Mar 27, 2024 · 7f4ddc0 · 7f4ddc0
1 parent 30b8825
commit 7f4ddc0
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 8 deletions.
diff --git a/R/utils.R b/R/utils.R
@@ -32,6 +32,8 @@ samp_by_grp <- function(samp, pop, dom_nm, B) {
     dplyr::mutate(map_args = list(list(n.x, n.y, add_to))) 
 
   all_samps <- vector("list", length = B)
+  ord <- rep(setup[[dom_nm]], times = setup$n.x)
+  pop_ordered <- pop[match(ord, pop[[dom_nm]]), ]
 
   for (i in 1:B) {
     ids <- setup |>
@@ -41,7 +43,7 @@ samp_by_grp <- function(samp, pop, dom_nm, B) {
       dplyr::pull(samps) |>
       unlist()
 
-    out <- pop[ids, ]
+    out <- pop_ordered[ids, ]
     all_samps[[i]] <- out
   }
 

diff --git a/tests/testthat/test-saeczi.R b/tests/testthat/test-saeczi.R
@@ -8,13 +8,15 @@ samp <- samp |>
 
 
 set.seed(5)
-result <- saeczi(samp,
-                 pop, 
-                 lin_formula,
-                 domain_level = "COUNTYFIPS",
-                 mse_est = TRUE,
-                 B = 10L,
-                 parallel = FALSE)
+suppressWarnings(
+  result <- saeczi(samp,
+                   pop, 
+                   lin_formula,
+                   domain_level = "COUNTYFIPS",
+                   mse_est = TRUE,
+                   B = 10L,
+                   parallel = FALSE)
+)
 
 test_that("result$res is a df", {
   expect_s3_class(result$res, "data.frame")

diff --git a/tests/testthat/test-samp_by_grp.R b/tests/testthat/test-samp_by_grp.R
@@ -0,0 +1,16 @@
+data(samp)
+data(pop)
+
+res <- samp_by_grp(samp, pop, "COUNTYFIPS", 10)
+
+test_that("plots per group are correct", {
+  out <- vector(mode = "logical", length = 10)
+  chk <- as.data.frame(table(samp$COUNTYFIPS))
+  for (i in 1:10) {
+    cmp <- as.data.frame(table(res[[i]]$COUNTYFIPS))
+    mtch <- all.equal(chk$Freq, cmp$Freq)
+    out[i] <- mtch
+  }
+  expect_true(all(out))
+})
+