RS-20388: Handle missing data properly in survey logistic regression models

Author: jrwishart

R/variables.R

@@ -216,7 +216,9 @@ Probabilities.Regression <- function(object, newdata = NULL, ...)
         StopForUserError(sQuote("Probabilities"), " is not applicable to linear regression models.")
     if (isTRUE(object$stacked) && IsRServer())
         StopForUserError("Saving probabilitiles is currently not supported for stacked data.")
-    newdata <- ValidateNewData(object, newdata)
+    na.action <- if ("na.action" %in% ...names()) list(...)[["na.action"]] else na.pass
+    newdata <- ValidateNewData(object, newdata) |>
+        structure(na.action = na.action) # Ensure NA rows are preserved, survey models may drop them otherwise
     if (object$type %in% c("Ordered Logit", "Multinomial Logit"))
     {
         probs <- suppressWarnings(predict(object$original, newdata = newdata,
@@ -230,7 +232,7 @@ Probabilities.Regression <- function(object, newdata = NULL, ...)
 
     if (object$type == "Binary Logit")
     {
-        probs <- suppressWarnings(predict(object$original, newdata = newdata, na.action = na.pass, type = "response"))
+        probs <- suppressWarnings(predict(object$original, newdata = newdata, na.action = na.action, type = "response"))
         outcome.levels <- levels(Observed(object))
         if (length(outcome.levels) == 1L)
         {

tests/testthat/test-dataproblems.R

@@ -816,3 +816,26 @@ test_that("Removing missing entirely missing variables", {
             )
         )
 })
+
+test_that("RS-20388: Survey weighted models preserve number of respondents in predictions", {
+    some.weighted.data.for.logistic <- data.frame(
+        y = rbinom(100, size = 1, prob = 0.5),
+        x1 = rnorm(100),
+        weights = runif(100, min = 0.5, max = 2)
+    )
+    # Set some rows to missing
+    is.na(some.weighted.data.for.logistic$x1) <- sample(1:100, size = 10)
+    model <- Regression(
+        y ~ x1, data = some.weighted.data.for.logistic,
+        type = "Binary Logit",
+        weights = some.weighted.data.for.logistic$weights,
+        missing = "Exclude cases with missing data"
+    )
+    probabilities <- Probabilities(model)
+    probabilities |> expect_type("double")
+    probabilities |> nrow() |> expect_equal(100L)
+
+    probabilities.with.missing <- Probabilities(model, na.action = na.omit)
+    probabilities.with.missing |> expect_type("double")
+    probabilities.with.missing |> nrow() |> expect_equal(90L)
+})