Fix for #889 (#891)

* assigning all variables a test (even when all values are NA)

* increment version number

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result
     Tables
-Version: 1.4.0.9003
+Version: 1.4.0.9004
 Authors@R: 
     c(person(given = "Daniel D.",
              family = "Sjoberg",

NEWS.md

@@ -1,5 +1,7 @@
 # gtsummary (development version)
 
+* Bug fix in `add_p.tbl_summary()` for columns that are all `NA`. These variables no longer error; rather, a message is printed indicating the p-value is not possible to calculate. (#889)
+
 * Updated `tbl_svysummary()` to be compatible with {srvyr} package (#886)
 
 * Updated default header when using `tbl_uvregression(x=)` to `"**Outcome**"` (#867)

R/utils-add_p.R

@@ -185,9 +185,9 @@
   }
 
   # if all obs are missing, return NULL ----------------------------------------
-  if (length(data[[variable]]) == sum(is.na(data[[variable]]))) {
-    return(NULL)
-  }
+  # if (length(data[[variable]]) == sum(is.na(data[[variable]]))) {
+  #   return(NULL)
+  # }
 
   # if no test supplied, setting defaults --------------------------------------
   # if by var has 3 or more levels, return error...no default test.
@@ -227,16 +227,18 @@
 
   # calculate expected counts to select between chisq and fisher
   min_exp <-
-    expand.grid(
-      table(data[[variable]]) / sum(!is.na(data[[variable]])),
-      table(data[[by]]) / sum(!is.na(data[[by]]))
-    ) %>%
-    mutate(
-      exp = .data$Var1 * .data$Var2 *
-        sum(!is.na(data[[variable]]) & !is.na(data[[by]]))
-    ) %>%
-    pull(exp) %>%
-    min()
+    suppressWarnings(
+      expand.grid(
+        table(data[[variable]]) / sum(!is.na(data[[variable]])),
+        table(data[[by]]) / sum(!is.na(data[[by]]))
+      ) %>%
+        mutate(
+          exp = .data$Var1 * .data$Var2 *
+            sum(!is.na(data[[variable]]) & !is.na(data[[by]]))
+        ) %>%
+        pull(exp) %>%
+        min()
+    )
 
   # if expected counts >= 5 for all cells, chisq, otherwise Fishers exact
   if (min_exp >= 5) {
@@ -270,11 +272,6 @@
     return(test[[variable]])
   }
 
-  # if all obs are missing, return NULL ----------------------------------------
-  if (length(data$variables[[variable]]) == sum(is.na(data$variables[[variable]]))) {
-    return(NULL)
-  }
-
   # for continuous data, default to non-parametric tests
   if (summary_type %in% c("continuous", "continuous2")) {
     test_func <-

tests/testthat/test-add_difference.R

@@ -204,3 +204,18 @@ test_that("row formatting of differences and CIs work", {
     c("-4.6, 3.7", "-0.05, 0.44", "-18%, 9.9%", "-21%, 9.0%")
   )
 })
+
+test_that("no error with missing data", {
+  expect_message(
+    t1 <-
+      mtcars %>%
+      mutate(mpg = NA, hp = NA) %>%
+      select(mpg, hp, am) %>%
+      tbl_summary(by = "am", type = hp ~ "continuous", missing = 'no') %>%
+      add_difference()
+  )
+  expect_equal(
+    t1 %>% as_tibble(col_labels = FALSE) %>% dplyr::pull(p.value),
+    rep_len(NA_character_, 2)
+  )
+})

tests/testthat/test-add_p.tbl_summary.R

@@ -383,3 +383,18 @@ test_that("difftime works with wolcox", {
     "p=0.7"
   )
 })
+
+test_that("no error with missing data", {
+  expect_message(
+    t1 <-
+      mtcars %>%
+      mutate(mpg = NA, hp = NA) %>%
+      select(mpg, hp, am) %>%
+      tbl_summary(by = "am", type = hp ~ "continuous") %>%
+      add_p()
+  )
+  expect_equal(
+    t1 %>% as_tibble(col_labels = FALSE) %>% dplyr::pull(p.value),
+    rep_len(NA_character_, 4)
+  )
+})