From 44f087885ae631671348fe1708a836fd6020b509 Mon Sep 17 00:00:00 2001
From: Daniel Sjoberg <danield.sjoberg@gmail.com>
Date: Fri, 13 Sep 2024 13:59:04 -0700
Subject: [PATCH] adding `check_factor_has_levels()` check

---
 R/standalone-checks.R                      | 27 ++++++++++++++++++++++
 tests/testthat/_snaps/standalone-checks.md |  8 +++++++
 tests/testthat/test-standalone-checks.R    | 13 ++++++++++-
 3 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/R/standalone-checks.R b/R/standalone-checks.R
index 2dace24..bd5d6f6 100644
--- a/R/standalone-checks.R
+++ b/R/standalone-checks.R
@@ -543,6 +543,33 @@ check_no_na_factor_levels <- function(x,
   invisible(x)
 }
 
+#' Check for levels attribute exists for factor
+#'
+#' @param x (`data.frame`)\cr
+#'   a data frame
+#' @inheritParams check_class
+#' @keywords internal
+#' @noRd
+check_factor_has_levels <- function(x,
+                                    message =
+                                      "Factors with empty {.val levels} attribute are not allowed,
+                                       which was identified in column {.val {variable}}.",
+                                    arg_name = rlang::caller_arg(x),
+                                    class = "na_factor_levels",
+                                    call = get_cli_abort_call(),
+                                    envir = rlang::current_env()) {
+  check_data_frame(x, arg_name = arg_name, class = class, call = call, envir = envir)
+
+  for (variable in names(x)) {
+    if (is.factor(x[[variable]]) && rlang::is_empty(levels(x[[variable]]))) {
+      cli::cli_abort(message = message, class = c(class, "standalone-checks"), call = call, .envir = envir)
+    }
+  }
+
+  invisible(x)
+}
+
+
 #' Check is Numeric
 #'
 #' @inheritParams check_class
diff --git a/tests/testthat/_snaps/standalone-checks.md b/tests/testthat/_snaps/standalone-checks.md
index f8cdab6..c9fe672 100644
--- a/tests/testthat/_snaps/standalone-checks.md
+++ b/tests/testthat/_snaps/standalone-checks.md
@@ -127,6 +127,14 @@
       Error in `myfunc()`:
       ! Factors with NA levels are not allowed, which are present in column "Species".
 
+---
+
+    Code
+      myfunc(my_iris)
+    Condition
+      Error in `myfunc()`:
+      ! Factors with empty "levels" attribute are not allowed, which was identified in column "bad_fct_col".
+
 ---
 
     Code
diff --git a/tests/testthat/test-standalone-checks.R b/tests/testthat/test-standalone-checks.R
index 72951ed..f36b52a 100644
--- a/tests/testthat/test-standalone-checks.R
+++ b/tests/testthat/test-standalone-checks.R
@@ -215,7 +215,7 @@ test_that("check functions work", {
   expect_snapshot(myfunc(pi), error = TRUE)
 
   # check_no_na_factor_levels()
-  myfunc <- function(x){
+  myfunc <- function(x) {
     set_cli_abort_call()
     check_no_na_factor_levels(x)
   }
@@ -226,6 +226,17 @@ test_that("check functions work", {
   expect_silent(myfunc(iris))
   expect_snapshot(myfunc(my_iris), error = TRUE)
 
+  # check_factor_has_levels()
+  myfunc <- function(x) {
+    set_cli_abort_call()
+    check_factor_has_levels(x)
+  }
+  my_iris <- iris
+  my_iris$bad_fct_col <- factor(NA)
+
+  expect_silent(myfunc(iris))
+  expect_snapshot(myfunc(my_iris), error = TRUE)
+
   # check_numeric()
   myfunc <- function(x) {
     set_cli_abort_call()