Fix warnings being suppressed (#432)

Closes #408
insightsengineering · Sep 30, 2024 · 06ca118 · 06ca118
1 parent ccda419
commit 06ca118
Show file tree

Hide file tree

Showing 2 changed files with 63 additions and 1 deletion.
diff --git a/R/longData.R b/R/longData.R
@@ -397,6 +397,8 @@ longDataConstructor <- R6::R6Class(
 
             dat_ice <- sort_by(dat_ice, c(self$vars$subjid))
 
+            has_nonMAR_to_MAR <- FALSE
+
             for (subject in dat_ice[[self$vars$subjid]]) {
 
                 dat_ice_pt <- dat_ice[dat_ice[[self$vars$subjid]] == subject, ]
@@ -408,7 +410,6 @@ longDataConstructor <- R6::R6Class(
 
                 new_strategy <- dat_ice_pt[[self$vars$strategy]]
 
-                has_nonMAR_to_MAR <- FALSE
                 if (!update) {
                     visit <- dat_ice_pt[[self$vars$visit]]
                     self$ice_visit_index[[subject]] <- which(self$visits == visit)

diff --git a/tests/testthat/test-longData.R b/tests/testthat/test-longData.R
@@ -1063,3 +1063,64 @@ test_that("get_data() uses na.rm and nmar.rm correctly", {
     )
 
 })
+
+
+test_that("Warnings/errors are thrown when strategies are incorrectly updated", {
+    vars <- set_vars(
+        outcome = "out",
+        group = "group",
+        strategy = "strat",
+        subjid = "pt",
+        visit = "vis",
+        covariates = c("age")
+    )
+
+    dat <- tibble(
+        pt = factor(c("A", "A", "A", "B", "B", "B", "C", "C", "C"), levels = c("A", "B", "C")),
+        vis = factor(c("V1", "V2", "V3", "V1", "V2", "V3", "V1", "V2", "V3"), levels = c("V1", "V2", "V3")),
+        out = c(1, 2, 3, 4, 5, 6, 7, 8, 9),
+        group = factor(c("T", "T", "T", "C", "C", "C", "T", "T", "T"), levels = c("C", "T")),
+        age = rnorm(9)
+    )
+    dat_ice <- tibble(
+        pt = factor(c("A", "B", "C"), levels = c("A", "B", "C")),
+        vis = factor( c("V2", "V2", "V2"), levels = c("V1", "V2", "V3")),
+        strat = c("JR", "MAR", "JR")
+    )
+    longdata <- longDataConstructor$new(dat, vars)
+    longdata$set_strategies(dat_ice)
+
+    # Error if updating MAR -> Non-Mar
+    ld2 <- longdata$clone()
+    dat_ice_upd <- tibble(
+        pt = factor(c("A", "B", "C"), levels = c("A", "B", "C")),
+        strat = c("JR", "JR", "JR")
+    )
+    expect_error(
+        ld2$update_strategies(dat_ice_upd),
+        regexp = "Updating strategies from MAR to non-MAR is invalid"
+    )
+
+    # Warning if updating Non-MAR -> MAR
+    ld2 <- longdata$clone()
+    dat_ice_upd <- tibble(
+        pt = factor(c("A", "B", "C"), levels = c("A", "B", "C")),
+        strat = c("JR", "MAR", "MAR")
+    )
+    expect_warning(
+        ld2$update_strategies(dat_ice_upd),
+        regexp = "Updating strategies from non-MAR to MAR.*You are advised to re-run `draws\\(\\)`"
+    )
+
+    # Same as above but catches niche bug where the warning would be supressed
+    # if a correct imputation came after an incorrect
+    ld2 <- longdata$clone()
+    dat_ice_upd <- tibble(
+        pt = factor(c("A", "B", "C"), levels = c("A", "B", "C")),
+        strat = c("MAR", "MAR", "JR")
+    )
+    expect_warning(
+        ld2$update_strategies(dat_ice_upd),
+        regexp = "Updating strategies from non-MAR to MAR.*You are advised to re-run `draws\\(\\)`"
+    )
+})