Bug fix for random-groups jackknife with variance strata

bschneidr · Oct 11, 2023 · 158b2e3 · 158b2e3
1 parent 1598dc7
commit 158b2e3
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 8 deletions.
diff --git a/R/as_jackknife_design.R b/R/as_jackknife_design.R
@@ -229,18 +229,14 @@ as_random_group_jackknife_design.survey.design <- function(
     stop("`scale_method` must be either 'variance-stratum-psus' or 'variance-units'")
   }
 
-  # Extract necessary design information
+  # Begin extracting necessary design information
   n <- nrow(design)
-
   design_vars <- data.frame(
     'ROW_ID' = seq_len(n),
-    'STRATUM' = design$strata[,1,drop=TRUE],
-    'PSU' = interaction(design$strata[,1,drop=TRUE],
-                        design$cluster[,1,drop=TRUE],
-                        drop = TRUE) |> as.numeric(),
-    stringsAsFactors = FALSE
+    'STRATUM' = design$strata[,1,drop=TRUE]
   )
 
+  # Handle VAR_STRAT variable
   if (!is.null(var_strat)) {
     if (!(var_strat %in% colnames(design$variables))) {
       stop("`var_strat` must be either NULL or the name of a variable in the data.")
@@ -254,6 +250,13 @@ as_random_group_jackknife_design.survey.design <- function(
     design_vars[['VAR_STRAT']] <- 1
   }
 
+  # Create unique PSU IDs within
+  # combinations of variance strata and design strata
+  design_vars[['PSU']] <- interaction(design_vars[['VAR_STRAT']],
+                                      design$strata[,1,drop=TRUE],
+                                      design$cluster[,1,drop=TRUE],
+                                      drop = TRUE) |> as.numeric()
+
   # Warn the user about FPCs and check that `var_strat_frac` is valid
 
   if (!is.null(design$fpc$popsize)) {
@@ -308,6 +311,7 @@ as_random_group_jackknife_design.survey.design <- function(
   n_psus <- design_vars$PSU |> unique() |> length()
   psu_random_labels <- sample(x = n_psus, size = n_psus, replace = FALSE)
   design_vars[['RAND_PSU_ID']] <- interaction(
+    design_vars[['VAR_STRAT']],
     design_vars[['STRATUM']],
     psu_random_labels[design_vars[['PSU']]],
     drop = TRUE, lex.order = TRUE

diff --git a/tests/testthat/test-random-group-jackknife.R b/tests/testthat/test-random-group-jackknife.R
@@ -31,7 +31,7 @@ set.seed(2014)
 
 # Test for expected formation of random groups ----
 
-  test_that(desc = "Random groups formed correctly", {
+  test_that(desc = "Random groups (without var_strat) formed correctly", {
 
     ## Correct sizes for random groups
     jk_design <- as_random_group_jackknife_design(
@@ -62,6 +62,24 @@ set.seed(2014)
 
   })
 
+  test_that(desc = "Random groups (with var_strat) formed correctly", {
+
+    ## Correct sizes for random groups
+    jk_design <- as_random_group_jackknife_design(
+      design = dstrat_nofpc,
+      var_strat = "stype",
+      replicates = 5
+    )
+
+    expect_equal(
+      object = jk_design$variables |>
+        count(stype, .random_group) |>
+        pull("n"),
+      expected = c(rep(c(20, 10, 10), each = 5))
+    )
+
+  })
+
 # Given the random groups, replicates formed correctly ----
 
   test_that(desc = "Replicates formed correctly, given random groups", {