Merge branch 'main' into rc_datawizard_1.2.0

Author: etiennebacher

R/data_tabulate.R

@@ -504,8 +504,12 @@ as.table.datawizard_table <- function(x, remove_na = TRUE, simplify = FALSE, ver
   if (!is.data.frame(x)) {
     x <- x[[1]]
   }
+  # check if any table has NA values - the column "Value" contains the value
+  # "NA", and the column "N" contains the frequency of this value.
   if (remove_na) {
-    if (verbose) {
+    # .check_table_na() works on lists of data frames, so we wrap the data frame
+    # into a list here
+    if (verbose && .check_table_na(list(x))) {
       insight::format_alert("Removing NA values from frequency table.")
     }
     # remove NA values from the table
@@ -524,7 +528,7 @@ as.table.datawizard_table <- function(x, remove_na = TRUE, simplify = FALSE, ver
 #' @export
 as.table.datawizard_tables <- function(x, remove_na = TRUE, simplify = FALSE, verbose = TRUE, ...) {
   # only show message once we set `verbose = FALSE` in the lapply()
-  if (remove_na && verbose) {
+  if (remove_na && verbose && .check_table_na(x)) {
     insight::format_alert("Removing NA values from frequency table.")
   }
 
@@ -564,7 +568,7 @@ as.table.datawizard_crosstab <- function(x, remove_na = TRUE, simplify = FALSE,
   rownames(x) <- row_names
 
   if (remove_na) {
-    if (verbose) {
+    if (verbose && .check_xtable_na(list(x))) {
       insight::format_alert("Removing NA values from frequency table.")
     }
     if (!is.null(x[["NA"]])) {
@@ -587,7 +591,7 @@ as.table.datawizard_crosstab <- function(x, remove_na = TRUE, simplify = FALSE,
 #' @export
 as.table.datawizard_crosstabs <- function(x, remove_na = TRUE, simplify = FALSE, verbose = TRUE, ...) {
   # only show message once we set `verbose = FALSE` in the lapply()
-  if (remove_na && verbose) {
+  if (remove_na && verbose && .check_xtable_na(x)) {
     insight::format_alert("Removing NA values from frequency table.")
   }
 
@@ -613,6 +617,7 @@ as.table.datawizard_crosstabs <- function(x, remove_na = TRUE, simplify = FALSE,
   out
 }
 
+
 .is_grouped_df_xtab <- function(x) {
   if (!is.data.frame(x)) {
     x <- x[[1]]
@@ -621,6 +626,37 @@ as.table.datawizard_crosstabs <- function(x, remove_na = TRUE, simplify = FALSE,
 }
 
 
+.check_table_na <- function(x) {
+  # check if any table has NA values - the column "Value" contains the value
+  # "NA", and the column "N" contains the frequency of this value.
+  any(vapply(x, function(i) any(i$N[is.na(i$Value)] > 0), logical(1)))
+}
+
+
+.check_xtable_na <- function(x) {
+  any(vapply(x, function(i) {
+    # need to extract rownames, to check if we have a "NA" row
+    row_names <- as.character(i[[1]])
+    row_names[is.na(row_names)] <- "NA"
+    has_na <- FALSE
+    # check for NA columns and rows
+    if (!is.null(i[["NA"]])) {
+      has_na <- any(i[["NA"]] > 0)
+    }
+    if ("NA" %in% row_names) {
+      # for grouped data frames, we need to remove the "Group" column, else
+      # the indexing -1 below won't work
+      if (.is_grouped_df_xtab(i)) {
+        i$Group <- NULL
+      }
+      # we need "as.data.frame()" for grouped df, else `as.vector()` fails
+      has_na <- has_na | any(as.vector(as.data.frame(i[row_names == "NA", -1])) > 0)
+    }
+    has_na
+  }, logical(1)))
+}
+
+
 # format --------------------
 
 #' @export

tests/testthat/_snaps/data_tabulate.md

@@ -699,8 +699,6 @@
 
     Code
       as.table(x)
-    Message
-      Removing NA values from frequency table.
     Output
       [[1]]
        4  6  8 
@@ -711,8 +709,6 @@
 
     Code
       as.table(x)
-    Message
-      Removing NA values from frequency table.
     Output
       [[1]]
        4  6  8 
@@ -733,8 +729,6 @@
 
     Code
       as.table(x)
-    Message
-      Removing NA values from frequency table.
     Output
       [[1]]
        4  6  8 
@@ -749,8 +743,6 @@
 
     Code
       as.table(x)
-    Message
-      Removing NA values from frequency table.
     Output
       [[1]]
          3  4  5
@@ -763,8 +755,6 @@
 
     Code
       as.table(x, simplify = TRUE)
-    Message
-      Removing NA values from frequency table.
     Output
          3  4  5
       4  1  8  2
@@ -775,8 +765,6 @@
 
     Code
       as.table(x)
-    Message
-      Removing NA values from frequency table.
     Output
       [[1]]
          3  4  5
@@ -789,8 +777,6 @@
 
     Code
       as.table(x, simplify = TRUE)
-    Message
-      Removing NA values from frequency table.
     Output
          3  4  5
       4  1  8  2
@@ -801,8 +787,6 @@
 
     Code
       as.table(x)
-    Message
-      Removing NA values from frequency table.
     Output
       [[1]]
          3  4  5
@@ -820,8 +804,6 @@
 
     Code
       as.table(x)
-    Message
-      Removing NA values from frequency table.
     Output
       $`am (0)`
          3  4

tests/testthat/test-data_tabulate.R

@@ -573,7 +573,45 @@ test_that("data_tabulate, table methods", {
   expect_named(as.table(x), c("am (0)", "am (1)"))
   expect_snapshot(as.table(x))
 
-  # messages
-  expect_message(as.table(data_tabulate(mtcars, "cyl")), regex = "Removing NA values")
+  # messages - no missings to remove
+  expect_silent(as.table(data_tabulate(mtcars, "cyl")))
   expect_silent(as.table(data_tabulate(mtcars, "cyl"), verbose = FALSE))
 })
+
+
+test_that("data_tabulate, table methods, only warn if necessary", {
+  # missings
+  data(efc)
+
+  # single variable
+  expect_message(as.table(data_tabulate(efc$c172code)))
+  expect_silent(as.table(data_tabulate(efc$c172code, remove_na = TRUE)))
+  expect_silent(as.table(data_tabulate(efc$c172code), remove_na = FALSE))
+  expect_silent(as.table(data_tabulate(efc$c172code), verbose = FALSE))
+
+  # cross table
+  expect_message(
+    as.table(data_tabulate(efc, "c172code", by = "e42dep")),
+    regex = "Removing NA values"
+  )
+  expect_silent(as.table(data_tabulate(efc, "c172code", by = "e42dep", remove_na = TRUE)))
+  expect_silent(as.table(data_tabulate(efc, "c172code", by = "e42dep"), remove_na = FALSE))
+  expect_silent(as.table(data_tabulate(efc, "c172code", by = "e42dep"), verbose = FALSE))
+
+  # no missings
+  data(mtcars)
+
+  # single variable
+  expect_silent(as.table(data_tabulate(mtcars$gear)))
+  expect_silent(as.table(data_tabulate(mtcars$gear, remove_na = TRUE)))
+  expect_silent(as.table(data_tabulate(mtcars$gear), verbose = FALSE))
+
+  # cross table
+  expect_silent(as.table(data_tabulate(mtcars, "gear", by = "cyl")))
+  expect_silent(as.table(data_tabulate(mtcars, "gear", by = "cyl", remove_na = TRUE)))
+  expect_silent(as.table(data_tabulate(mtcars, "gear", by = "cyl"), verbose = FALSE))
+
+  # group DF throws no warning
+  d <- data_group(mtcars, "am")
+  expect_silent(as.table(data_tabulate(d, "cyl", by = "gear")))
+})