From 748a3c3e07a668974d4725fc3d45845e4111b7b1 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Fri, 27 Mar 2026 21:54:19 +0100
Subject: [PATCH] feat: dropped auto dropping empty factor levels

---
 R/helpers.R           |  4 ++--
 R/update-factor-ext.R | 44 +++++++++++++++++++++++++++++++++++++++----
 2 files changed, 42 insertions(+), 6 deletions(-)

diff --git a/R/helpers.R b/R/helpers.R
index adc12777..514cf6a4 100644
--- a/R/helpers.R
+++ b/R/helpers.R
@@ -230,8 +230,8 @@ default_parsing <- function(data) {
       REDCapCAST::as_factor() |>
       REDCapCAST::numchar2fct(numeric.threshold = 8,
                               character.throshold = 10) |>
-      REDCapCAST::as_logical() |>
-      REDCapCAST::fct_drop()
+      REDCapCAST::as_logical() #|>
+      # REDCapCAST::fct_drop()
   })
   # out <-
   #
diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R
index ad1b263c..93f35910 100644
--- a/R/update-factor-ext.R
+++ b/R/update-factor-ext.R
@@ -29,15 +29,26 @@ update_factor_ui <- function(id) {
     ),
     fluidRow(
       column(
-        width = 6,
+        width = 3,
         shinyWidgets::virtualSelectInput(
           inputId = ns("variable"),
-          label = i18n$t("Factor variable to reorder:"),
+          label = i18n$t("Choose variable:"),
           choices = NULL,
           width = "100%",
           zIndex = 50
         )
       ),
+      column(
+        width = 3,
+        class = "d-flex align-items-end",
+        actionButton(
+          disabled = TRUE,
+          inputId = ns("drop_levels"),
+          label = tagList(phosphoricons::ph("sort-ascending"), i18n$t("Drop empty")),
+          class = "btn-outline-primary mb-3",
+          width = "100%"
+        )
+      ),
       column(
         width = 3,
         class = "d-flex align-items-end",
@@ -70,7 +81,9 @@ update_factor_ui <- function(id) {
       class = "float-end",
       shinyWidgets::prettyCheckbox(
         inputId = ns("new_var"),
-        label = i18n$t("Create a new variable; otherwise replaces (Updating labels always creates new variable)"),
+        label = i18n$t(
+          "Create a new variable; otherwise replaces (Updating labels always creates new variable)"
+        ),
         value = FALSE,
         status = "primary",
         outline = TRUE,
@@ -125,6 +138,20 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
       rv$data_grid <- grid
     })
 
+    observeEvent(rv$data_grid, {
+      variable <- req(input$variable)
+      if (isTRUE(has_empty_levels(rv$data[[variable]]))) {
+        # browser()
+        updateActionButton(inputId = "drop_levels", disabled = FALSE)
+      } else {
+        updateActionButton(inputId = "drop_levels", disabled = TRUE)
+      }
+    })
+
+    observeEvent(input$drop_levels, {
+      rv$data_grid <- rv$data_grid[!rv$data_grid$Freq==0,]
+    })
+
     observeEvent(input$sort_levels, {
       if (input$sort_levels %% 2 == 1) {
         decreasing <- FALSE
@@ -208,7 +235,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
       )
 
       data <- tryCatch({
-        with_labels(data,{
+        with_labels(data, {
           rlang::exec(factor_new_levels_labels,
                       !!!modifyList(parameters, val = list(data = data)))
         })
@@ -370,3 +397,12 @@ unique_names <- function(new, existing = character()) {
 
   new_names[-seq_along(existing)]
 }
+
+
+has_empty_levels <- function(x) {
+  if (is.factor(x)) {
+    any(!levels(x) %in% x)
+  } else {
+    return(FALSE)
+  }
+}