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 01/10] 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)
+  }
+}

From 9b4ddafe6f086aa3a0e4aef011de4d4320d0d00e Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Fri, 27 Mar 2026 21:56:57 +0100
Subject: [PATCH 02/10] fix: keep level labels

---
 R/redcap_read_shiny_module.R | 378 ++++++++++++++++++-----------------
 1 file changed, 194 insertions(+), 184 deletions(-)

diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R
index a74c599a..2b26d929 100644
--- a/R/redcap_read_shiny_module.R
+++ b/R/redcap_read_shiny_module.R
@@ -11,10 +11,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
   ns <- shiny::NS(id)
 
   if (isTRUE(title)) {
-    title <- shiny::tags$h4(
-      i18n$t("Import data from REDCap"),
-      class = "redcap-module-title"
-    )
+    title <- shiny::tags$h4(i18n$t("Import data from REDCap"), class = "redcap-module-title")
   }
 
   server_ui <- shiny::tagList(
@@ -25,7 +22,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       value = if_not_missing(url, "https://redcap.your.institution/"),
       width = "100%"
     ),
-    shiny::helpText(i18n$t("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'")),
+    shiny::helpText(
+      i18n$t(
+        "Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
+      )
+    ),
     shiny::br(),
     shiny::br(),
     shiny::passwordInput(
@@ -34,7 +35,9 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       value = "",
       width = "100%"
     ),
-    shiny::helpText(i18n$t("The token is a string of 32 numbers and letters.")),
+    shiny::helpText(i18n$t(
+      "The token is a string of 32 numbers and letters."
+    )),
     shiny::br(),
     shiny::br(),
     shiny::actionButton(
@@ -51,7 +54,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shinyWidgets::alert(
         id = ns("connect-result"),
         status = "info",
-        tags$p(phosphoricons::ph("info", weight = "bold"), i18n$t("Please fill in web address and API token, then press 'Connect'."))
+        tags$p(
+          phosphoricons::ph("info", weight = "bold"),
+          i18n$t("Please fill in web address and API token, then press 'Connect'.")
+        )
       ),
       dismissible = TRUE
     ),
@@ -64,8 +70,8 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shiny::uiOutput(outputId = ns("arms")),
       shiny::textInput(
         inputId = ns("filter"),
-        label = i18n$t("Optional filter logic (e.g., ⁠[gender] = 'female')"
-      ))
+        label = i18n$t("Optional filter logic (e.g., ⁠[gender] = 'female')")
+      )
     )
 
   params_ui <-
@@ -96,7 +102,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
           )
         )
       ),
-      shiny::helpText(i18n$t("Select fields/variables to import and click the funnel to apply optional filters")),
+      shiny::helpText(
+        i18n$t(
+          "Select fields/variables to import and click the funnel to apply optional filters"
+        )
+      ),
       shiny::tags$br(),
       shiny::tags$br(),
       shiny::uiOutput(outputId = ns("data_type")),
@@ -115,7 +125,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
         shinyWidgets::alert(
           id = ns("retrieved-result"),
           status = "info",
-          tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
+          tags$p(
+            phosphoricons::ph("info", weight = "bold"),
+            "Please specify data to download, then press 'Import'."
+          )
         ),
         dismissible = TRUE
       )
@@ -126,11 +139,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
     title = title,
     server_ui,
     # shiny::uiOutput(ns("params_ui")),
-    shiny::conditionalPanel(
-      condition = "output.connect_success == true",
-      params_ui,
-      ns = ns
-    ),
+    shiny::conditionalPanel(condition = "output.connect_success == true", params_ui, ns = ns),
     shiny::br()
   )
 }
@@ -162,7 +171,11 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$api)
       shiny::req(input$uri)
       if (!is.null(input$uri)) {
-        uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
+        uri <- paste0(ifelse(
+          endsWith(input$uri, "/"),
+          input$uri,
+          paste0(input$uri, "/")
+        ), "api/")
       } else {
         uri <- input$uri
       }
@@ -176,75 +189,68 @@ m_redcap_readServer <- function(id) {
     })
 
 
-    tryCatch(
-      {
-        shiny::observeEvent(
-          list(
-            input$data_connect
-          ),
-          {
-            shiny::req(input$api)
-            shiny::req(data_rv$uri)
+    tryCatch({
+      shiny::observeEvent(list(input$data_connect), {
+        shiny::req(input$api)
+        shiny::req(data_rv$uri)
 
-            parameters <- list(
-              redcap_uri = data_rv$uri,
-              token = input$api
-            )
+        parameters <- list(redcap_uri = data_rv$uri, token = input$api)
 
-            # browser()
-            shiny::withProgress(
-              {
-                imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
-              },
-              message = paste("Connecting to", data_rv$uri)
-            )
+        # browser()
+        shiny::withProgress({
+          imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters),
+                          silent = TRUE)
+        }, message = paste("Connecting to", data_rv$uri))
 
-            ## TODO: Simplify error messages
-            if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
-              if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
-                mssg <- imported$raw_text
-              } else {
-                mssg <- attr(imported, "condition")$message
-              }
+        ## TODO: Simplify error messages
+        if (inherits(imported, "try-error") ||
+            NROW(imported) < 1 ||
+            ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
+          if (ifelse(is.list(imported),
+                     !isTRUE(imported$success),
+                     FALSE)) {
+            mssg <- imported$raw_text
+          } else {
+            mssg <- attr(imported, "condition")$message
+          }
 
-              datamods:::insert_error(mssg = mssg, selector = "connect")
-              data_rv$dd_status <- "error"
-              data_rv$dd_list <- NULL
-            } else if (isTRUE(imported$success)) {
-              data_rv$dd_status <- "success"
+          datamods:::insert_error(mssg = mssg, selector = "connect")
+          data_rv$dd_status <- "error"
+          data_rv$dd_list <- NULL
+        } else if (isTRUE(imported$success)) {
+          data_rv$dd_status <- "success"
 
-              data_rv$info <- REDCapR::redcap_project_info_read(
-                redcap_uri = data_rv$uri,
-                token = input$api
-              )$data
+          data_rv$info <- REDCapR::redcap_project_info_read(redcap_uri = data_rv$uri, token = input$api)$data
 
-              datamods:::insert_alert(
-                selector = ns("connect"),
-                status = "success",
-                include_data_alert(
-                  see_data_text = i18n$t("Click to see data dictionary"),
-                  dataIdName = "see_dd",
-                  extra = tags$p(
-                    tags$b(phosphoricons::ph("check", weight = "bold"), i18n$t("Connected to server!")),
-                    glue::glue(i18n$t("The {data_rv$info$project_title} project is loaded."))
-                  ),
-                  btn_show_data = TRUE
+          datamods:::insert_alert(
+            selector = ns("connect"),
+            status = "success",
+            include_data_alert(
+              see_data_text = i18n$t("Click to see data dictionary"),
+              dataIdName = "see_dd",
+              extra = tags$p(
+                tags$b(
+                  phosphoricons::ph("check", weight = "bold"),
+                  i18n$t("Connected to server!")
+                ),
+                glue::glue(
+                  i18n$t(
+                    "The {data_rv$info$project_title} project is loaded."
+                  )
                 )
-              )
+              ),
+              btn_show_data = TRUE
+            )
+          )
 
-              data_rv$dd_list <- imported
-            }
-          },
-          ignoreInit = TRUE
-        )
-      },
-      warning = function(warn) {
-        showNotification(paste0(warn), type = "warning")
-      },
-      error = function(err) {
-        showNotification(paste0(err), type = "err")
-      }
-    )
+          data_rv$dd_list <- imported
+        }
+      }, ignoreInit = TRUE)
+    }, warning = function(warn) {
+      showNotification(paste0(warn), type = "warning")
+    }, error = function(err) {
+      showNotification(paste0(err), type = "err")
+    })
 
     output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
     shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
@@ -275,10 +281,7 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$api)
       shiny::req(data_rv$uri)
 
-      REDCapR::redcap_event_read(
-        redcap_uri = data_rv$uri,
-        token = input$api
-      )$data
+      REDCapR::redcap_event_read(redcap_uri = data_rv$uri, token = input$api)$data
     })
 
     output$fields <- shiny::renderUI({
@@ -288,7 +291,7 @@ m_redcap_readServer <- function(id) {
         label = i18n$t("Select fields/variables to import:"),
         choices = purrr::pluck(data_rv$dd_list, "data") |>
           dplyr::select(field_name, form_name) |>
-          (\(.x){
+          (\(.x) {
             split(.x$field_name, REDCapCAST::as_factor(.x$form_name))
           })(),
         updateOn = "change",
@@ -321,14 +324,10 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$data_type)
 
       ## Get repeated field
-      data_rv$rep_fields <- data_rv$dd_list$data$field_name[
-        data_rv$dd_list$data$form_name %in% repeated_instruments(
-          uri = data_rv$uri,
-          token = input$api
-        )
-      ]
+      data_rv$rep_fields <- data_rv$dd_list$data$field_name[data_rv$dd_list$data$form_name %in% repeated_instruments(uri = data_rv$uri, token = input$api)]
 
-      if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
+      if (input$data_type == "long" &&
+          isTRUE(any(input$fields %in% data_rv$rep_fields))) {
         vectorSelectInput(
           inputId = ns("fill"),
           label = i18n$t("Fill missing values?"),
@@ -370,7 +369,6 @@ m_redcap_readServer <- function(id) {
       # browser()
       record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
 
-
       parameters <- list(
         uri = data_rv$uri,
         token = input$api,
@@ -386,26 +384,31 @@ m_redcap_readServer <- function(id) {
       )
 
       shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
-        imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
+        imported <- tryCatch(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters),
+                        silent = TRUE)
       })
 
-      parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
+      # d <- REDCapCAST::apply_factor_labels(data = imported$survey, meta = data_rv$dd_list$data)
 
-      code <- rlang::call2(
-        "easy_redcap",
-        !!!utils::modifyList(
-          parameters_code,
-          list(
-            data_format = ifelse(
-              input$data_type == "long" && !is.null(input$data_type),
-              "long",
-              "wide"
-            ),
-            project.name = simple_snake(data_rv$info$project_title)
-          )
-        ),
-        .ns = "REDCapCAST"
-      )
+      parameters_code <- parameters[c("uri",
+                                      "fields",
+                                      "events",
+                                      "raw_or_label",
+                                      "filter_logic")]
+
+      code <- rlang::call2("easy_redcap",
+                           !!!utils::modifyList(
+                             parameters_code,
+                             list(
+                               data_format = ifelse(
+                                 input$data_type == "long" && !is.null(input$data_type),
+                                 "long",
+                                 "wide"
+                               ),
+                               project.name = simple_snake(data_rv$info$project_title)
+                             )
+                           ),
+                           .ns = "REDCapCAST")
 
       if (inherits(imported, "try-error") || NROW(imported) < 1) {
         data_rv$data_status <- "error"
@@ -419,7 +422,6 @@ m_redcap_readServer <- function(id) {
         ## "wide"/"long" without re-importing data
 
         if (parameters$split_form == "all") {
-          # browser()
           out <- imported |>
             # redcap_wider()
             REDCapCAST::redcap_wider()
@@ -442,78 +444,91 @@ m_redcap_readServer <- function(id) {
           }
         }
 
-        # browser()
+        ## Ensure correct factor labels
+        ## It is a little hacky and should be included in the read_redcap_tables, but is lost along the way
+        out <- REDCapCAST::apply_factor_labels(data = out, meta = data_rv$dd_list$data)
+
+
         in_data_check <- parameters$fields %in% names(out) |
-          sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
+          sapply(names(out), \(.x) any(sapply(
+            parameters$fields, \(.y) startsWith(.x, .y)
+          )))
 
         if (!any(in_data_check[-1])) {
           data_rv$data_status <- "warning"
-          data_rv$data_message <- i18n$t("Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
+          data_rv$data_message <- i18n$t(
+            "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+          )
         }
 
         if (!all(in_data_check)) {
           data_rv$data_status <- "warning"
-          data_rv$data_message <- i18n$t("Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
+          data_rv$data_message <- i18n$t(
+            "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+          )
         }
 
         data_rv$code <- code
 
+        ## Level labels nare lost at this point...
         data_rv$data <- out |>
           dplyr::select(-dplyr::ends_with("_complete")) |>
           # dplyr::select(-dplyr::any_of(record_id)) |>
           REDCapCAST::suffix2label()
+
       }
     })
 
-    shiny::observeEvent(
-      data_rv$data_status,
-      {
-        # browser()
-        if (identical(data_rv$data_status, "error")) {
-          datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
-        } else if (identical(data_rv$data_status, "success")) {
-          datamods:::insert_alert(
-            selector = ns("retrieved"),
-            status = data_rv$data_status,
-            # tags$p(
-            #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
-            #   data_rv$data_message
-            # ),
-            include_data_alert(
-              see_data_text = i18n$t("Click to see the imported data"),
-              dataIdName = "see_data",
-              extra = tags$p(
-                tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
-              ),
-              btn_show_data = TRUE
-            )
-          )
-        } else {
-          datamods:::insert_alert(
-            selector = ns("retrieved"),
-            status = data_rv$data_status,
-            tags$p(
-              tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
+    shiny::observeEvent(data_rv$data_status, {
+      # browser()
+      if (identical(data_rv$data_status, "error")) {
+        datamods:::insert_error(mssg = data_rv$data_message,
+                                selector = ns("retrieved"))
+      } else if (identical(data_rv$data_status, "success")) {
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = data_rv$data_status,
+          # tags$p(
+          #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+          #   data_rv$data_message
+          # ),
+          include_data_alert(
+            see_data_text = i18n$t("Click to see the imported data"),
+            dataIdName = "see_data",
+            extra = tags$p(tags$b(
+              phosphoricons::ph("check", weight = "bold"),
               data_rv$data_message
-            )
+            )),
+            btn_show_data = TRUE
           )
-        }
+        )
+      } else {
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = data_rv$data_status,
+          tags$p(
+            tags$b(
+              phosphoricons::ph("warning", weight = "bold"),
+              "Warning!"
+            ),
+            data_rv$data_message
+          )
+        )
       }
-    )
+    })
 
-    return(list(
-      status = shiny::reactive(data_rv$data_status),
-      name = shiny::reactive(data_rv$info$project_title),
-      info = shiny::reactive(data_rv$info),
-      code = shiny::reactive(data_rv$code),
-      data = shiny::reactive(data_rv$data)
-    ))
+    return(
+      list(
+        status = shiny::reactive(data_rv$data_status),
+        name = shiny::reactive(data_rv$info$project_title),
+        info = shiny::reactive(data_rv$info),
+        code = shiny::reactive(data_rv$code),
+        data = shiny::reactive(data_rv$data)
+      )
+    )
   }
 
-  shiny::moduleServer(
-    id = id,
-    module = module
-  )
+  shiny::moduleServer(id = id, module = module)
 }
 
 #' @importFrom htmltools tagList tags
@@ -524,14 +539,12 @@ include_data_alert <- function(dataIdName = "see_data",
                                extra = NULL,
                                session = shiny::getDefaultReactiveDomain()) {
   if (isTRUE(btn_show_data)) {
-    success_message <- tagList(
-      extra,
-      tags$br(),
-      shiny::actionLink(
-        inputId = session$ns(dataIdName),
-        label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
-      )
-    )
+    success_message <- tagList(extra,
+                               tags$br(),
+                               shiny::actionLink(
+                                 inputId = session$ns(dataIdName),
+                                 label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
+                               ))
   }
   return(success_message)
 }
@@ -583,20 +596,18 @@ is_valid_redcap_url <- function(url) {
 #' @examples
 #' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
 #' is_valid_token(token)
-is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
+is_valid_token <- function(token,
+                           pattern_env = NULL,
+                           nchar = 32) {
   checkmate::assert_character(token, any.missing = TRUE, len = 1)
 
   if (!is.null(pattern_env)) {
-    checkmate::assert_character(pattern_env,
-      any.missing = FALSE,
-      len = 1
-    )
+    checkmate::assert_character(pattern_env, any.missing = FALSE, len = 1)
     pattern <- pattern_env
   } else {
     pattern <- glue::glue("^([0-9A-Fa-f]{<nchar>})(?:\\n)?$",
-      .open = "<",
-      .close = ">"
-    )
+                          .open = "<",
+                          .close = ">")
   }
 
   if (is.na(token)) {
@@ -636,10 +647,15 @@ repeated_instruments <- function(uri, token) {
 #' @export
 #'
 drop_empty_event <- function(data, event = "redcap_event_name") {
-  generics <- c(names(data)[1], "redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
+  generics <- c(
+    names(data)[1],
+    "redcap_event_name",
+    "redcap_repeat_instrument",
+    "redcap_repeat_instance"
+  )
 
   filt <- split(data, data[[event]]) |>
-    lapply(\(.x){
+    lapply(\(.x) {
       dplyr::select(.x, -tidyselect::all_of(generics)) |>
         REDCapCAST::all_na()
     }) |>
@@ -667,16 +683,10 @@ redcap_demo_app <- function() {
   server <- function(input, output, session) {
     data_val <- m_redcap_readServer(id = "data")
 
-    output$data <- DT::renderDataTable(
-      {
-        shiny::req(data_val$data)
-        data_val$data()
-      },
-      options = list(
-        scrollX = TRUE,
-        pageLength = 5
-      ),
-    )
+    output$data <- DT::renderDataTable({
+      shiny::req(data_val$data)
+      data_val$data()
+    }, options = list(scrollX = TRUE, pageLength = 5), )
     output$code <- shiny::renderPrint({
       shiny::req(data_val$code)
       data_val$code()

From ce0ecef633ac2e56c6cbbbb52658bb07342a3b32 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:16:33 +0200
Subject: [PATCH 03/10] fix: adjusted to not allow typing

---
 R/custom_SelectInput.R  | 48 +++++++++++++++++++++++++----------------
 man/colorSelectInput.Rd |  2 +-
 2 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/R/custom_SelectInput.R b/R/custom_SelectInput.R
index 8ac469be..cd460b78 100644
--- a/R/custom_SelectInput.R
+++ b/R/custom_SelectInput.R
@@ -270,7 +270,7 @@ vectorSelectInput <- function(inputId,
 colorSelectInput <- function(inputId,
                              label,
                              choices,
-                             selected = "",
+                             selected = NULL,
                              previews = 4,
                              ...,
                              placeholder = "") {
@@ -306,31 +306,43 @@ colorSelectInput <- function(inputId,
 
   choices_new <- stats::setNames(vals, labels)
 
+  if (is.null(selected) || selected == "") {
+    selected <- vals[[1]]
+  }
+
   shiny::selectizeInput(
     inputId  = inputId,
     label    = label,
     choices  = choices_new,
     selected = selected,
     ...,
-    options  = list(
+    options = list(
       render = I(
         "{
-        option: function(item, escape) {
-          item.data = JSON.parse(item.label);
-          return '<div style=\"padding:3px 12px\">' +
-                   '<div><strong>' + escape(item.data.name) + '</strong></div>' +
-                   (item.data.label != '' ? '<div><small>' + escape(item.data.label) + '</small></div>' : '') +
-                   '<div style=\"margin-top:4px\">' + item.data.swatch + '</div>' +
-                 '</div>';
-        },
-        item: function(item, escape) {
-          item.data = JSON.parse(item.label);
-          return '<div style=\"display:flex;align-items:center;gap:6px\">' +
-                   '<span>' + escape(item.data.name) + '</span>' +
-                   item.data.swatch +
-                 '</div>';
-        }
-      }"
+    option: function(item, escape) {
+      item.data = JSON.parse(item.label);
+      return '<div style=\"padding:3px 12px\">' +
+               '<div><strong>' + escape(item.data.name) + '</strong></div>' +
+               (item.data.label != '' ? '<div><small>' + escape(item.data.label) + '</small></div>' : '') +
+               '<div style=\"margin-top:4px\">' + item.data.swatch + '</div>' +
+             '</div>';
+    },
+    item: function(item, escape) {
+      item.data = JSON.parse(item.label);
+      return '<div style=\"display:flex;align-items:center;gap:6px\">' +
+               '<span>' + escape(item.data.name) + '</span>' +
+               item.data.swatch +
+             '</div>';
+    }
+  }"
+      ),
+      onInitialize = I(
+        "function() {
+    var self = this;
+    self.$control_input.prop('readonly', true);
+    self.$control_input.css('cursor', 'default');
+    self.$control.css('cursor', 'pointer');
+  }"
       )
     )
   )
diff --git a/man/colorSelectInput.Rd b/man/colorSelectInput.Rd
index 37561b0f..0f673a0b 100644
--- a/man/colorSelectInput.Rd
+++ b/man/colorSelectInput.Rd
@@ -9,7 +9,7 @@ colorSelectInput(
   inputId,
   label,
   choices,
-  selected = "",
+  selected = NULL,
   previews = 4,
   ...,
   placeholder = ""

From ba031094162a8eabdb95540fd276aafc7b6fe853 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:17:13 +0200
Subject: [PATCH 04/10] feat: new likert plot

---
 R/plot_likert.R   | 50 +++++++++++++++++++++++++++++++++++++++++++++++
 man/data-plots.Rd | 16 +++++++++++++--
 2 files changed, 64 insertions(+), 2 deletions(-)
 create mode 100644 R/plot_likert.R

diff --git a/R/plot_likert.R b/R/plot_likert.R
new file mode 100644
index 00000000..625bb844
--- /dev/null
+++ b/R/plot_likert.R
@@ -0,0 +1,50 @@
+#' Nice horizontal bar plot centred on the central category
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @name data-plots
+#'
+#' @examples
+#' mtcars |> plot_likert(pri = "carb", sec = "cyl")
+#' mtcars |> plot_likert(pri = "carb", sec = "cyl", ter="am")
+#' mtcars |> plot_likert(pri = "cyl",color.palette="Blues")
+#' mtcars |> plot_likert(pri = "carb", sec = NULL,color.palette="Magma")
+#' mtcars |> plot_likert(pri = "carb", sec = c("cyl","am"),color.palette="Viridis")
+plot_likert <- function(data,
+                        pri,
+                        sec = NULL,
+                        ter = NULL,
+                        color.palette = "viridis") {
+  if (!is.null(ter)) {
+    ds <- split(data, data[ter])
+  } else {
+    ds <- list(data)
+  }
+  out <- lapply(ds, \(.x) {
+    .x[c(pri, sec)] |>
+      # na.omit() |>
+      plot_likert_single(color.palette = color.palette)
+  })
+
+  wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")))
+}
+
+
+plot_likert_single <- function(data, color.palette = "viridis") {
+  ggstats::gglikert(data = data) +
+    scale_fill_generate(palette=color.palette)+
+    ggplot2::theme(
+      # legend.position = "none",
+      # panel.grid.major = element_blank(),
+      # panel.grid.minor = element_blank(),
+      # axis.text.y = ggplot2::element_blank(),
+      # axis.title.y = ggplot2::element_blank(),
+      text = ggplot2::element_text(size = 12)
+      # axis.text = ggplot2::element_blank(),
+      # plot.title = element_blank(),
+      # panel.background = ggplot2::element_rect(fill = "white"),
+      # plot.background = ggplot2::element_rect(fill = "white"),
+      # panel.border = ggplot2::element_blank()
+    )
+}
diff --git a/man/data-plots.Rd b/man/data-plots.Rd
index 5229751a..8f6534f4 100644
--- a/man/data-plots.Rd
+++ b/man/data-plots.Rd
@@ -1,7 +1,7 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/data_plots.R, R/plot_bar.R, R/plot_box.R,
-%   R/plot_hbar.R, R/plot_ridge.R, R/plot_sankey.R, R/plot_scatter.R,
-%   R/plot_violin.R
+%   R/plot_hbar.R, R/plot_likert.R, R/plot_ridge.R, R/plot_sankey.R,
+%   R/plot_scatter.R, R/plot_violin.R
 \name{data-plots}
 \alias{data-plots}
 \alias{data_visuals_ui}
@@ -11,6 +11,7 @@
 \alias{plot_box}
 \alias{plot_box_single}
 \alias{plot_hbars}
+\alias{plot_likert}
 \alias{plot_ridge}
 \alias{sankey_ready}
 \alias{plot_sankey}
@@ -48,6 +49,8 @@ plot_box_single(data, pri, sec = NULL, seed = 2103, color.palette = "viridis")
 
 plot_hbars(data, pri, sec, ter = NULL, color.palette = "viridis")
 
+plot_likert(data, pri, sec = NULL, ter = NULL, color.palette = "viridis")
+
 plot_ridge(data, x, y, z = NULL, color.palette = "viridis", ...)
 
 sankey_ready(data, pri, sec, numbers = "count", ...)
@@ -107,6 +110,8 @@ ggplot2 object
 
 ggplot2 object
 
+ggplot2 object
+
 data.frame
 
 ggplot2 object
@@ -128,6 +133,8 @@ Create nice box-plots
 
 Nice horizontal stacked bars (Grotta bars)
 
+Nice horizontal bar plot centred on the central category
+
 Plot nice ridge plot
 
 Readying data for sankey plot
@@ -164,6 +171,11 @@ mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
 mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues")
 mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma")
 mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis")
+mtcars |> plot_likert(pri = "carb", sec = "cyl")
+mtcars |> plot_likert(pri = "carb", sec = "cyl", ter="am")
+mtcars |> plot_likert(pri = "cyl",color.palette="Blues")
+mtcars |> plot_likert(pri = "carb", sec = NULL,color.palette="Magma")
+mtcars |> plot_likert(pri = "carb", sec = c("cyl","am"),color.palette="Viridis")
 mtcars |>
   default_parsing() |>
   plot_ridge(x = "mpg", y = "cyl")

From 163cbffeafa7223f7e3fb7cf7911f9bb6d24643d Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:18:10 +0200
Subject: [PATCH 05/10] chore: prepare baseline table for an even more compact
 version without empty levels in categorical

---
 R/baseline_table.R     | 48 ++++++++++++++++++++++++------------------
 man/create_baseline.Rd |  3 ++-
 2 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/R/baseline_table.R b/R/baseline_table.R
index 9d6f587f..39b51744 100644
--- a/R/baseline_table.R
+++ b/R/baseline_table.R
@@ -11,7 +11,10 @@
 #' @examples
 #' mtcars |> baseline_table()
 #' mtcars |> baseline_table(fun.args = list(by = "gear"))
-baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) {
+baseline_table <- function(data,
+                           fun.args = NULL,
+                           fun = gtsummary::tbl_summary,
+                           vars = NULL) {
   out <- do.call(fun, c(list(data = data), fun.args))
   return(out)
 }
@@ -37,7 +40,15 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
 #' mtcars |> create_baseline(by.var = "gear", detail_level = "extended",type = list(gtsummary::all_dichotomous() ~ "categorical"),theme="nejm")
 #'
 #' create_baseline(default_parsing(mtcars), by.var = "am", add.p = FALSE, add.overall = FALSE, theme = "lancet")
-create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, add.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon"), detail_level = c("minimal", "extended")) {
+create_baseline <- function(data,
+                            ...,
+                            by.var,
+                            add.p = FALSE,
+                            add.diff = FALSE,
+                            add.overall = FALSE,
+                            theme = c("jama", "lancet", "nejm", "qjecon"),
+                            detail_level = c("minimal", "extended"),
+                            drop_empty = FALSE) {
   theme <- match.arg(theme)
 
   detail_level <- match.arg(detail_level)
@@ -64,31 +75,28 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, ad
   if (!any(hasName(args, c("type", "statistic")))) {
     if (detail_level == "extended") {
       args <-
-        modifyList(
-          args,
-          list(
-            type = list(gtsummary::all_continuous() ~ "continuous2",
-                        gtsummary::all_dichotomous() ~ "categorical"),
-            statistic = list(gtsummary::all_continuous() ~ c(
-              "{median} ({p25}, {p75})",
-              "{mean} ({sd})",
-              "{min}, {max}"))
+        modifyList(args, list(
+          type = list(
+            gtsummary::all_continuous() ~ "continuous2",
+            gtsummary::all_dichotomous() ~ "categorical"
+          ),
+          statistic = list(
+            gtsummary::all_continuous() ~ c("{median} ({p25}, {p75})", "{mean} ({sd})", "{min}, {max}")
           )
-        )
+        ))
     }
   }
 
-  parameters <- list(
-    data = data,
-    fun.args = purrr::list_flatten(list(by = by.var, args))
-  )
+  if (isTRUE(drop_empty)) {
+    ## Drops empty levels if minimal
+    data <- data |> REDCapCAST::fct_drop()
+  }
+
+  parameters <- list(data = data, fun.args = purrr::list_flatten(list(by = by.var, args)))
 
 
   # browser()
-  out <- do.call(
-    baseline_table,
-    parameters
-  )
+  out <- do.call(baseline_table, parameters)
 
 
   if (!is.null(by.var)) {
diff --git a/man/create_baseline.Rd b/man/create_baseline.Rd
index 23b3621f..bca41929 100644
--- a/man/create_baseline.Rd
+++ b/man/create_baseline.Rd
@@ -12,7 +12,8 @@ create_baseline(
   add.diff = FALSE,
   add.overall = FALSE,
   theme = c("jama", "lancet", "nejm", "qjecon"),
-  detail_level = c("minimal", "extended")
+  detail_level = c("minimal", "extended"),
+  drop_empty = FALSE
 )
 }
 \arguments{

From 18eae4b3a317fa3272d45751f02c9492fbf9cd8d Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:18:28 +0200
Subject: [PATCH 06/10] feat: likert plot definitions

---
 R/data_plots.R | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/R/data_plots.R b/R/data_plots.R
index cd590cce..1ae13694 100644
--- a/R/data_plots.R
+++ b/R/data_plots.R
@@ -351,7 +351,7 @@ data_visuals_server <- function(id,
 
       shiny::observeEvent(input$act_plot, {
         if (NROW(data()) > 0) {
-          tryCatch({
+            tryCatch({
             parameters <- list(
               type = rv$plot.params()[["fun"]],
               pri = input$primary,
@@ -377,7 +377,7 @@ data_visuals_server <- function(id,
           #   showNotification(paste0(warn), type = "warning")
           # },
           error = function(err) {
-            showNotification(paste0(err), type = "err")
+            showNotification(paste0(err), type = "error")
           })
         }
       }, ignoreInit = TRUE)
@@ -600,6 +600,18 @@ supported_plots <- function() {
       secondary.max = 4,
       tertiary.type = c("dichotomous"),
       secondary.extra = NULL
+    ),
+    plot_euler = list(
+      fun = "plot_likert",
+      descr = i18n$t("Likert diagram"),
+      note = i18n$t(
+        "Plot survey results"
+      ),
+      primary.type = c("dichotomous", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = TRUE,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = NULL
     )
   )
 }

From 9122ce2663558bffdc8718c8382c58630309282b Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:19:11 +0200
Subject: [PATCH 07/10] fix: allow filtering data when character columns are
 present.

---
 R/helpers.R | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)

diff --git a/R/helpers.R b/R/helpers.R
index 514cf6a4..bd982c47 100644
--- a/R/helpers.R
+++ b/R/helpers.R
@@ -840,3 +840,54 @@ data_types <- function() {
                        "Any other class")
   )
 }
+
+non_character_cols <- function(df) {
+  if (shiny::is.reactive(df)) df <- df()
+  df[, !sapply(df, is.character), drop = FALSE]
+}
+
+apply_idea_filter <- function(filtered_reactive, df_target, env = parent.frame()) {
+  # If this ever brakes, the solution will have to be to modify the original filter function
+  if (shiny::is.reactive(df_target)) df_target <- df_target()
+
+  result      <- if (shiny::is.reactive(filtered_reactive)) filtered_reactive() else filtered_reactive
+  filter_code <- attr(result, "code")
+
+  if (is.null(filter_code)) return(df_target)
+
+  deparsed <- paste(deparse(filter_code), collapse = "")
+
+  if (is.symbol(filter_code) || !grepl("filter(", deparsed, fixed = TRUE)) {
+    return(df_target)
+  }
+
+  extract_filters <- function(code) {
+    filters <- list()
+    while (!is.symbol(code) && deparse(code[[1]]) == "%>%") {
+      rhs <- code[[3]]
+      if (deparse(rhs[[1]]) == "filter") {
+        filters <- c(list(rhs), filters)
+      }
+      code <- code[[2]]
+    }
+    if (!is.symbol(code) && deparse(code[[1]]) == "filter") {
+      filters <- c(list(code), filters)
+    }
+    filters
+  }
+
+  tryCatch({
+    out <- df_target
+    for (f in extract_filters(filter_code)) {
+      args <- lapply(rlang::call_args(f), function(arg) {
+        rlang::new_quosure(arg, env = env)
+      })
+      out <- dplyr::filter(out, !!!args)
+    }
+    out
+  },
+  error = function(e) {
+    warning("Could not apply filter: ", conditionMessage(e))
+    df_target
+  })
+}

From c28a3d0a6d1df26a167c2da7ab086db7e87ba330 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:19:52 +0200
Subject: [PATCH 08/10] feat: redcap server side export filter validation

---
 R/redcap_read_shiny_module.R  | 411 +++++++++++++++++++++++++++++++++-
 man/validate_redcap_filter.Rd |  72 ++++++
 2 files changed, 471 insertions(+), 12 deletions(-)
 create mode 100644 man/validate_redcap_filter.Rd

diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R
index 2b26d929..810cab0c 100644
--- a/R/redcap_read_shiny_module.R
+++ b/R/redcap_read_shiny_module.R
@@ -71,13 +71,17 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shiny::textInput(
         inputId = ns("filter"),
         label = i18n$t("Optional filter logic (e.g., ⁠[gender] = 'female')")
-      )
+      ),
+      uiOutput(ns("filter_feedback"))
     )
 
   params_ui <-
     shiny::tagList(
       shiny::tags$h4(i18n$t("Data import parameters")),
       shiny::tags$div(
+        ####
+        #### All below was deactivated to deactivate filtering
+        ####
         style = htmltools::css(
           display = "grid",
           gridTemplateColumns = "1fr 50px",
@@ -164,7 +168,8 @@ m_redcap_readServer <- function(id) {
       dd_list = NULL,
       data = NULL,
       rep_fields = NULL,
-      code = NULL
+      code = NULL,
+      filter_valid = NULL
     )
 
     shiny::observeEvent(list(input$api, input$uri), {
@@ -249,7 +254,7 @@ m_redcap_readServer <- function(id) {
     }, warning = function(warn) {
       showNotification(paste0(warn), type = "warning")
     }, error = function(err) {
-      showNotification(paste0(err), type = "err")
+      showNotification(paste0(err), type = "error")
     })
 
     output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
@@ -363,19 +368,57 @@ m_redcap_readServer <- function(id) {
       }
     })
 
+
+    filter_validation <- reactive({
+      val <- trimws(input$filter)
+      if (nchar(val) == 0)
+        return(NULL)
+      validate_redcap_filter(val, purrr::pluck(data_rv$dd_list, "data"))
+    })
+
+    output$filter_feedback <- renderUI({
+      result <- filter_validation()
+      if (is.null(result)) {
+        data_rv$filter_valid <- NULL
+        return(NULL)
+      }
+
+      if (result$valid) {
+        data_rv$filter_valid <- TRUE
+        tags$span(style = "color: green;", "\u2713 Filter is valid")
+      } else {
+        data_rv$filter_valid <- FALSE
+
+        tags$span(style = "color: red;",
+                  "\u2717 ",
+                  line_break(result$message, lineLength = 30))
+      }
+    })
+
     shiny::observeEvent(input$data_import, {
       shiny::req(input$fields)
 
       # browser()
       record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
 
+      if (!is.null(data_rv$filter_valid)) {
+        if (isTRUE(data_rv$filter_valid)) {
+          filter <- trimws(input$filter)
+        } else {
+          filter <- ""
+        }
+      } else {
+        filter <- ""
+      }
+
       parameters <- list(
         uri = data_rv$uri,
         token = input$api,
         fields = unique(c(record_id, input$fields)),
         events = input$arms,
         raw_or_label = "both",
-        filter_logic = input$filter,
+        filter_logic = filter,
+        # filter_logic = "",
         split_forms = ifelse(
           input$data_type == "long" && !is.null(input$data_type),
           "none",
@@ -384,8 +427,17 @@ m_redcap_readServer <- function(id) {
       )
 
       shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
-        imported <- tryCatch(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters),
-                        silent = TRUE)
+        imported <- try({
+          rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters)
+          # if (nrow(out)==0){
+          #   stop("No data was exported")
+          # } else {
+          #   out
+          # }
+        }, # error = function(err) {
+        #   showNotification(i18n$t("An error was encountered exporting data. Please review data filter."), type = "error")
+        # },
+        silent = TRUE)
       })
 
       # d <- REDCapCAST::apply_factor_labels(data = imported$survey, meta = data_rv$dd_list$data)
@@ -410,10 +462,13 @@ m_redcap_readServer <- function(id) {
                            ),
                            .ns = "REDCapCAST")
 
-      if (inherits(imported, "try-error") || NROW(imported) < 1) {
+      if (inherits(imported, "try-error") |
+          NROW(imported) == 0 |
+          (length(imported) == 1 & !is.list(imported))) {
         data_rv$data_status <- "error"
         data_rv$data_list <- NULL
-        data_rv$data_message <- imported$raw_text
+        data_rv$data_message <- i18n$t("An empty data set was imported. Please review data filter.")
+        data_rv$data <- NULL
       } else {
         data_rv$data_status <- "success"
         data_rv$data_message <- i18n$t("Requested data was retrieved!")
@@ -426,7 +481,7 @@ m_redcap_readServer <- function(id) {
             # redcap_wider()
             REDCapCAST::redcap_wider()
         } else {
-          if (input$fill == "yes") {
+          if (identical(input$fill, "yes")) {
             ## Repeated fields
 
 
@@ -480,10 +535,21 @@ m_redcap_readServer <- function(id) {
     })
 
     shiny::observeEvent(data_rv$data_status, {
-      # browser()
       if (identical(data_rv$data_status, "error")) {
-        datamods:::insert_error(mssg = data_rv$data_message,
-                                selector = ns("retrieved"))
+        ## The insert error wouldn't work. Inserted through regular.
+        # datamods:::insert_error(mssg = data_rv$data_message,
+        #                         selector = ns("retrieved"))
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = "danger",
+          tags$p(
+            tags$b(
+              phosphoricons::ph("warning", weight = "bold"),
+              "Warning!"
+            ),
+            data_rv$data_message
+          )
+        )
       } else if (identical(data_rv$data_status, "success")) {
         datamods:::insert_alert(
           selector = ns("retrieved"),
@@ -665,6 +731,327 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
 }
 
 
+#' Validate a REDCap server-side filter string against a data dictionary
+#'
+#' Checks that a REDCap filter expression is syntactically correct and
+#' consistent with the field types defined in the project data dictionary.
+#' Plain text without field references is always rejected. Multi-clause
+#' filters joined by \code{AND} or \code{OR} are supported.
+#'
+#' @param filter A single character string containing the filter expression,
+#'   e.g. \code{"[age] > 18"} or \code{"[cohabitation] = '1' AND [age] > 18"}.
+#' @param dictionary A data frame representing the REDCap data dictionary in
+#'   API export format, as returned by e.g. \code{REDCapCAST::get_redcap_metadata()}.
+#'   Must contain at least the columns \code{field_name} and \code{field_type}.
+#'   The columns \code{text_validation_type_or_show_slider_number} and
+#'   \code{select_choices_or_calculations} are used when present for stricter
+#'   type and choice validation.
+#'
+#' @return A named list with two elements:
+#'   \describe{
+#'     \item{\code{valid}}{Logical. \code{TRUE} if the filter passes all checks.}
+#'     \item{\code{message}}{Character. \code{"Filter is valid."} on success, or
+#'       a newline-separated string of error messages describing every problem
+#'       found.}
+#'   }
+#'
+#' @details
+#' Validation rules by field type:
+#' \describe{
+#'   \item{\code{calc}}{Numeric fields. Value must be an unquoted number.
+#'     All comparison operators (\code{=}, \code{!=}, \code{<}, \code{>},
+#'     \code{<=}, \code{>=}) are accepted.}
+#'   \item{\code{text} with date validation}{Fields with validation type
+#'     \code{date_ymd}, \code{date_dmy}, \code{datetime_*}, etc. Value must be
+#'     a quoted date/datetime string in \code{'YYYY-MM-DD'} format. All
+#'     comparison operators are accepted.}
+#'   \item{\code{text} with time validation}{Fields with validation type
+#'     \code{time_hh_mm_ss} or \code{time_mm_ss}. Value must be a quoted time
+#'     string, e.g. \code{'14:30:00'}. All comparison operators are accepted.}
+#'   \item{\code{radio} / \code{dropdown}}{Categorical fields. Value must be a
+#'     quoted choice code (e.g. \code{'1'}) that exists in the field's choice
+#'     list. Only \code{=} and \code{!=} are accepted.}
+#'   \item{\code{text} (plain)}{Free-text fields. Value must be a quoted string.
+#'     Only \code{=} and \code{!=} are accepted.}
+#' }
+#'
+#' @examples
+#' \dontrun{
+#' dict <- REDCapCAST::get_redcap_metadata(
+#'   uri    = "https://redcap.example.com/api/",
+#'   token  = Sys.getenv("REDCAP_TOKEN")
+#' )
+#'
+#' validate_redcap_filter("[age] > 18", dict)
+#' #> list(valid = TRUE, message = "Filter is valid.")
+#'
+#' validate_redcap_filter("only plain text", dict)
+#' #> list(valid = FALSE, message = "Filter must contain at least one field ...")
+#'
+#' validate_redcap_filter("[cohabitation] = '1' AND [age] > 18", dict)
+#' #> list(valid = TRUE, message = "Filter is valid.")
+#' }
+#'
+#' @export
+# REDCap filter validation based on data dictionary
+#
+# REDCap filter format: [field_name] operator value
+# Example: [age] > 18
+#          [cohabitation] = '1'
+#          [inclusion] > '2020-01-01'
+#
+# Supported field types and their allowed operators/value formats:
+#   text (no validation) -> string values, = != operators only
+#   text (date_ymd/date_dmy) -> quoted date strings, all comparison operators
+#   text (time_hh_mm_ss) -> quoted time strings, all comparison operators
+#   text (datetime_*) -> quoted datetime strings, all comparison operators
+#   text (autocomplete) -> string values, = != operators only
+#   calc -> numeric values, all comparison operators
+#   radio/dropdown -> quoted numeric codes, = != operators only
+
+validate_redcap_filter <- function(filter, dictionary) {
+  # --- Input checks ---
+  if (!is.character(filter) ||
+      length(filter) != 1 || nchar(trimws(filter)) == 0) {
+    return(list(valid = FALSE, message = "Filter must be a non-empty string."))
+  }
+
+  if (!grepl("\\[.+\\]", filter)) {
+    return(
+      list(valid = FALSE, message = "Filter must contain at least one field reference in [brackets]. Plain text is not accepted.")
+    )
+  }
+
+  # --- Column names (API export format) ---
+  col_field    <- "field_name"
+  col_type     <- "field_type"
+  col_val_type <- "text_validation_type_or_show_slider_number"
+  col_choices  <- "select_choices_or_calculations"
+
+  missing_cols <- setdiff(c(col_field, col_type), names(dictionary))
+  if (length(missing_cols) > 0) {
+    stop("Dictionary is missing required columns: ",
+         paste(missing_cols, collapse = ", "))
+  }
+
+  # --- Build lookup index once for O(1) field access ---
+  field_idx    <- setNames(seq_len(nrow(dictionary)), dictionary[[col_field]])
+  has_val_type <- col_val_type %in% names(dictionary)
+  has_choices  <- col_choices  %in% names(dictionary)
+
+  # --- Classify field types ---
+  numeric_types    <- c("calc")
+  date_validations <- c(
+    "date_ymd",
+    "date_dmy",
+    "datetime_ymd",
+    "datetime_dmy",
+    "datetime_seconds_ymd",
+    "datetime_seconds_dmy"
+  )
+  time_validations <- c("time_hh_mm_ss", "time_mm_ss")
+  categorical_types <- c("radio", "dropdown", "checkbox")
+  text_types        <- c("text", "autocomplete")
+
+  num_ops  <- c("=", "!=", "<", ">", "<=", ">=")
+  cat_ops  <- c("=", "!=")
+  text_ops <- c("=", "!=")
+
+  # --- Parse filter into clauses ---
+  # Split on AND/OR (REDCap uses 'and'/'or' or 'AND'/'OR')
+  clauses <- trimws(strsplit(filter, "(?i)\\s+(and|or)\\s+", perl = TRUE)[[1]])
+
+  clause_pattern <- "^\\[([^\\]]+)\\]\\s*(=|!=|<=|>=|<|>)\\s*(.+)$"
+
+  errors <- character(0)
+
+  for (clause in clauses) {
+    if (!grepl(clause_pattern, clause, perl = TRUE)) {
+      errors <- c(
+        errors,
+        sprintf(
+          "Clause '%s' does not match expected format: [field] operator value",
+          clause
+        )
+      )
+      next
+    }
+
+    parts    <- regmatches(clause, regexec(clause_pattern, clause, perl = TRUE))[[1]]
+    field    <- parts[2]
+    operator <- parts[3]
+    value    <- trimws(parts[4])
+
+    # --- Check field exists using pre-built index ---
+    row_i <- field_idx[field]
+    if (is.na(row_i)) {
+      errors <- c(errors, sprintf("Unknown field: [%s]", field))
+      next
+    }
+
+    field_type <- dictionary[[col_type]][row_i]
+    val_type   <- if (has_val_type)
+      dictionary[[col_val_type]][row_i]
+    else
+      ""
+    if (is.na(val_type))
+      val_type <- ""
+
+    # --- Determine expected value format and allowed operators ---
+    if (field_type %in% numeric_types ||
+        grepl("^integer$|^number", val_type)) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is numeric — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^-?[0-9]+(\\.[0-9]+)?$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is numeric — value '%s' should be an unquoted number (e.g. 18 or 3.5)",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (val_type %in% date_validations) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a date — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl(
+        "^'[0-9]{4}-[0-9]{2}-[0-9]{2}(\\s[0-9]{2}:[0-9]{2}(:[0-9]{2})?)?'$",
+        value
+      )) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a date — value '%s' should be a quoted date string, e.g. '2020-01-31'",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (val_type %in% time_validations) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a time — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^'[0-9]{2}:[0-9]{2}(:[0-9]{2})?'$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a time — value '%s' should be a quoted time string, e.g. '14:30:00'",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (field_type %in% categorical_types) {
+      if (!operator %in% cat_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is categorical — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(cat_ops, collapse = ", ")
+          )
+        )
+      }
+
+      # Validate value is a known choice code
+      choices_raw <- if (has_choices)
+        dictionary[[col_choices]][row_i]
+      else
+        NA
+      if (!is.na(choices_raw) && nchar(trimws(choices_raw)) > 0) {
+        choice_codes <- trimws(gsub(",.+?(\\||$)", "", gsub(
+          "^\\s*", "", strsplit(choices_raw, "\\|")[[1]]
+        )))
+        value_unquoted <- gsub("^'|'$", "", value)
+        if (!value_unquoted %in% choice_codes) {
+          errors <- c(
+            errors,
+            sprintf(
+              "[%s] is categorical — '%s' is not a valid choice code. Valid codes: %s",
+              field,
+              value_unquoted,
+              paste(choice_codes, collapse = ", ")
+            )
+          )
+        }
+      }
+
+      if (!grepl("^'.*'$", value)) {
+        errors <- c(errors,
+                    sprintf(
+                      "[%s] is categorical — value should be quoted, e.g. '1'",
+                      field
+                    ))
+      }
+
+    } else {
+      # Plain text field
+      if (!operator %in% text_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a text field — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(text_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^'.*'$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a text field — value should be quoted, e.g. 'some text'",
+            field
+          )
+        )
+      }
+    }
+  }
+
+  if (length(errors) > 0) {
+    return(list(
+      valid = FALSE,
+      message = paste(errors, collapse = "\n")
+    ))
+  }
+
+  list(valid = TRUE, message = "Filter is valid.")
+}
+
+
+
 #' Test app for the redcap_read_shiny_module
 #'
 #' @rdname redcap_read_shiny_module
diff --git a/man/validate_redcap_filter.Rd b/man/validate_redcap_filter.Rd
new file mode 100644
index 00000000..9fb42c5d
--- /dev/null
+++ b/man/validate_redcap_filter.Rd
@@ -0,0 +1,72 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/redcap_read_shiny_module.R
+\name{validate_redcap_filter}
+\alias{validate_redcap_filter}
+\title{Validate a REDCap server-side filter string against a data dictionary}
+\usage{
+validate_redcap_filter(filter, dictionary)
+}
+\arguments{
+\item{filter}{A single character string containing the filter expression,
+e.g. \code{"[age] > 18"} or \code{"[cohabitation] = '1' AND [age] > 18"}.}
+
+\item{dictionary}{A data frame representing the REDCap data dictionary in
+API export format, as returned by e.g. \code{REDCapCAST::get_redcap_metadata()}.
+Must contain at least the columns \code{field_name} and \code{field_type}.
+The columns \code{text_validation_type_or_show_slider_number} and
+\code{select_choices_or_calculations} are used when present for stricter
+type and choice validation.}
+}
+\value{
+A named list with two elements:
+\describe{
+\item{\code{valid}}{Logical. \code{TRUE} if the filter passes all checks.}
+\item{\code{message}}{Character. \code{"Filter is valid."} on success, or
+a newline-separated string of error messages describing every problem
+found.}
+}
+}
+\description{
+Checks that a REDCap filter expression is syntactically correct and
+consistent with the field types defined in the project data dictionary.
+Plain text without field references is always rejected. Multi-clause
+filters joined by \code{AND} or \code{OR} are supported.
+}
+\details{
+Validation rules by field type:
+\describe{
+\item{\code{calc}}{Numeric fields. Value must be an unquoted number.
+All comparison operators (\code{=}, \code{!=}, \code{<}, \code{>},
+\code{<=}, \code{>=}) are accepted.}
+\item{\code{text} with date validation}{Fields with validation type
+\code{date_ymd}, \code{date_dmy}, \code{datetime_*}, etc. Value must be
+a quoted date/datetime string in \code{'YYYY-MM-DD'} format. All
+comparison operators are accepted.}
+\item{\code{text} with time validation}{Fields with validation type
+\code{time_hh_mm_ss} or \code{time_mm_ss}. Value must be a quoted time
+string, e.g. \code{'14:30:00'}. All comparison operators are accepted.}
+\item{\code{radio} / \code{dropdown}}{Categorical fields. Value must be a
+quoted choice code (e.g. \code{'1'}) that exists in the field's choice
+list. Only \code{=} and \code{!=} are accepted.}
+\item{\code{text} (plain)}{Free-text fields. Value must be a quoted string.
+Only \code{=} and \code{!=} are accepted.}
+}
+}
+\examples{
+\dontrun{
+dict <- REDCapCAST::get_redcap_metadata(
+  uri    = "https://redcap.example.com/api/",
+  token  = Sys.getenv("REDCAP_TOKEN")
+)
+
+validate_redcap_filter("[age] > 18", dict)
+#> list(valid = TRUE, message = "Filter is valid.")
+
+validate_redcap_filter("only plain text", dict)
+#> list(valid = FALSE, message = "Filter must contain at least one field ...")
+
+validate_redcap_filter("[cohabitation] = '1' AND [age] > 18", dict)
+#> list(valid = TRUE, message = "Filter is valid.")
+}
+
+}

From fcf422bc4b9544f8d8ed7ac6e5e445a83e9ff3d8 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:20:05 +0200
Subject: [PATCH 09/10] render

---
 CITATION.cff                         |   2 +-
 DESCRIPTION                          |   3 ++-
 NAMESPACE                            |   2 ++
 NEWS.md                              |  14 +++++++++++++-
 R/app_version.R                      |   2 +-
 R/cut-variable-ext.R                 |   2 +-
 R/hosted_version.R                   |   2 +-
 R/import-file-ext.R                  |   8 ++++----
 R/missings-module.R                  |   2 +-
 R/regression-module.R                |  10 +++++-----
 R/sysdata.rda                        | Bin 2685 -> 2704 bytes
 R/update-factor-ext.R                |   2 +-
 SESSION.md                           |  11 ++++++-----
 inst/translations/translation_da.csv |  14 ++++++--------
 inst/translations/translation_sw.csv |  14 ++++++--------
 renv.lock                            |  26 ++++++++++++++------------
 16 files changed, 64 insertions(+), 50 deletions(-)

diff --git a/CITATION.cff b/CITATION.cff
index f7e2ec6a..5578f1a5 100644
--- a/CITATION.cff
+++ b/CITATION.cff
@@ -8,7 +8,7 @@ message: 'To cite package "FreesearchR" in publications use:'
 type: software
 license: AGPL-3.0-or-later
 title: 'FreesearchR: Easy data analysis for clinicians'
-version: 26.3.4
+version: 26.3.5
 doi: 10.5281/zenodo.14527429
 identifiers:
 - type: url
diff --git a/DESCRIPTION b/DESCRIPTION
index def9fc81..3a60d461 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: FreesearchR
 Title: Easy data analysis for clinicians
-Version: 26.3.4
+Version: 26.3.5
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154")),
@@ -122,6 +122,7 @@ Collate:
     'plot_box.R'
     'plot_euler.R'
     'plot_hbar.R'
+    'plot_likert.R'
     'plot_ridge.R'
     'plot_sankey.R'
     'plot_scatter.R'
diff --git a/NAMESPACE b/NAMESPACE
index 97775d14..9ede131b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -122,6 +122,7 @@ export(plot_box_single)
 export(plot_euler)
 export(plot_euler_single)
 export(plot_hbars)
+export(plot_likert)
 export(plot_ridge)
 export(plot_sankey)
 export(plot_sankey_single)
@@ -166,6 +167,7 @@ export(update_factor_server)
 export(update_factor_ui)
 export(update_variables_server)
 export(update_variables_ui)
+export(validate_redcap_filter)
 export(validation_server)
 export(validation_ui)
 export(vectorSelectInput)
diff --git a/NEWS.md b/NEWS.md
index 3476df1d..7c2bbc32 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,10 +1,22 @@
+# FreesearchR 26.3.5
+
+*FIX* Labelled categorical variables were not handled correctly importing from REDCap resulting in lost labels. Fixed!
+
+*CHANGE* Testing in new data I realised, that automatically removing empty levels in categorical variables/factors is not desired. It should be a concious decision to remove levels. This is now possible in the "Modify factor" pop-up.
+
+*CHANGE* REDCap export now throws an error if no data was exported. The server side filtering prior to export is now validated and feedback is printed. Only valid filter statements are used when exporting data from the REDCap server. This is an advanced use case, but a great way to ensure only the minimum required data is exported from the server.
+
+*FIX* Applying filters now works also when the data contains text variables.
+
+*NEW* Initial support for plotting Likert scale survey results. This is expected to be further improved. For based on ggstats::gglikert.
+
 # FreesearchR 26.3.4
 
 *NEW* Color select for plotting across all plots for even more option. Ten palettes have been chosen, to provide varied and interpretable options. The selector will always show a preview of four colors.
 
 *NEW* Added app version check against latest release on GitHub. Only runs if internet connection present. No other polling.
 
-*NEW* Added a "Missing" level to the sankey plot function and adjusted the label font size. And fixed support for dichotomous data.
+*NEW* Added a "Missing" level to the Sankey plot function and adjusted the label font size. And fixed support for dichotomous data.
 
 # FreesearchR 26.3.3
 
diff --git a/R/app_version.R b/R/app_version.R
index c6d7307c..bdf15ee5 100644
--- a/R/app_version.R
+++ b/R/app_version.R
@@ -1 +1 @@
-app_version <- function()'26.3.4'
+app_version <- function()'26.3.5'
diff --git a/R/cut-variable-ext.R b/R/cut-variable-ext.R
index 508e846c..b7d8eb80 100644
--- a/R/cut-variable-ext.R
+++ b/R/cut-variable-ext.R
@@ -378,7 +378,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
             rlang::exec(cut_var, !!!parameters)
           },
           error = function(err) {
-            showNotification(paste("We encountered the following error creating the new factor:", err), type = "err")
+            showNotification(paste("We encountered the following error creating the new factor:", err), type = "error")
           }
         )
 
diff --git a/R/hosted_version.R b/R/hosted_version.R
index 6935edfb..19c31921 100644
--- a/R/hosted_version.R
+++ b/R/hosted_version.R
@@ -1 +1 @@
-hosted_version <- function()'v26.3.4-260324'
+hosted_version <- function()'v26.3.5-260330'
diff --git a/R/import-file-ext.R b/R/import-file-ext.R
index 745bbc0f..709a55c1 100644
--- a/R/import-file-ext.R
+++ b/R/import-file-ext.R
@@ -353,7 +353,7 @@ import_file_server <- function(id,
       #     showNotification(warn, type = "warning")
       # },
       error = function(err) {
-        showNotification(err, type = "err")
+        showNotification(err, type = "error")
       })
     })
 
@@ -370,7 +370,7 @@ import_file_server <- function(id,
           minBodyHeight = 250
         )
       }, error = function(err) {
-        showNotification(err, type = "err")
+        showNotification(err, type = "error")
       })
     })
 
@@ -485,7 +485,7 @@ import_xls <- function(file, sheet, skip, na.strings) {
   #   showNotification(paste0(warn), type = "warning")
   # },
   error = function(err) {
-    showNotification(paste0(err), type = "err")
+    showNotification(paste0(err), type = "error")
   })
 }
 
@@ -513,7 +513,7 @@ import_ods <- function(file, sheet, skip, na.strings) {
   #   showNotification(paste0(warn), type = "warning")
   # },
   error = function(err) {
-    showNotification(paste0(err), type = "err")
+    ?showNotification(paste0(err), type = "error")
   })
 }
 
diff --git a/R/missings-module.R b/R/missings-module.R
index 8b9c1f50..003a35f4 100644
--- a/R/missings-module.R
+++ b/R/missings-module.R
@@ -172,7 +172,7 @@ data_missings_server <- function(id, data, max_level = 20, ...) {
             out <- do.call(compare_missings, modifyList(parameters, list(data = df_tbl)))
           })
         }, error = function(err) {
-          showNotification(paste0("Error: ", err), type = "err")
+          showNotification(paste0("Error: ", err), type = "error")
         })
 
         if (is.null(input$missings_var) ||
diff --git a/R/regression-module.R b/R/regression-module.R
index e1bd364f..d569bd54 100644
--- a/R/regression-module.R
+++ b/R/regression-module.R
@@ -416,7 +416,7 @@ regression_server <- function(id,
               rv$list$regression$models <- model_lists
             },
             error = function(err) {
-              showNotification(paste(i18n$t("Creating regression models failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Creating regression models failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -481,7 +481,7 @@ regression_server <- function(id,
               showNotification(paste0(warn), type = "warning")
             },
             error = function(err) {
-              showNotification(paste(i18n$t("Creating a regression table failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Creating a regression table failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -559,7 +559,7 @@ regression_server <- function(id,
               gg_theme_shiny()
           },
           error = function(err) {
-            showNotification(paste0(err), type = "err")
+            showNotification(paste0(err), type = "error")
           }
         )
       })
@@ -619,7 +619,7 @@ regression_server <- function(id,
             #   showNotification(paste0(warn), type = "warning")
             # },
             error = function(err) {
-              showNotification(paste(i18n$t("Running model assumptions checks failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Running model assumptions checks failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -690,7 +690,7 @@ regression_server <- function(id,
                 out <- patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
               },
               error = function(err) {
-                showNotification(err, type = "err")
+                showNotification(err, type = "error")
               }
             )
 
diff --git a/R/sysdata.rda b/R/sysdata.rda
index 4e2466e66542431c55aacefa9da334dcbe7447a6..e57187506ab34278de0c95073a5e1f6f763aa4ac 100644
GIT binary patch
literal 2704
zcmV;B3UBp7T4*^jL0KkKSqf-34*(g<f5iX)Xaz!l|KNXb-@w2B|L{Nn00amD;0ym3
zI}=vp!0J6^F2D)^e0&d}3+w@+8kqnH03nbd5uq7BRD(2t$Y}JKk46YJPtXbxFi6^r
z${C_G02u%P0000Qr{vIzpfqFv00000000002{e%jQ^aaO@l1dZPzEN0Lm&a500D+n
zN$P%~>YGvM^$h|v(*TSRz#}G_0}V7y8Z^Qs5@?9?RQ)6#ra&~v05kvqW}pF(8&d?U
zaW5!v5V*%cEV6<sTLDz(W}+gxKK7MBMztZQ;ri^~FrkPsZ|-Q{E)#AkjFQR$NMtSP
zPQ|z7vj_o-2%<70y}R_{W8MF0Z(PsQ@bzFlv-&LPf4acfR6a9Oef3s8_tp9RR?!h`
zpzEvTcNN44@1<!80#aY?kl4L5l~7zV4XJsG6pd8OigIDaWQGjRF;PsTP_XT>5TAb{
z+}4v4@*ypkFwYLKi4a~XEoTH&t1ww<zhgc;$DHFYzi+n{v7;zbOU0*}@3y-xO7Agw
zEsIFOxP~=>FKV7{32MbvN~M4QcKj^a1LXAiHw{TFGfylry7X+&-v5*0l>+w_N;N2%
zV>kGhx$gyk2`4X^lcz^+Td^?G#tEWLPQtR@wZgU1MlL)CE{UU3>CFjtr4O}2{W^29
zt8JrhGKhu+Gwy1lf#K#Es%4c#m6C+JAV5KI)ikmcL{VcCM>1+Ln`adnsjRv-)QKjT
ztFm#MwPR_Dwykqe?@;LOcT_`LC}F9o;qFo@u3KhY8d*~=aYj`&M>d{$ImW|pw%clN
zh>cL=R@4n{LYKw{U7BUzeG_?yq#XqP+>#yu2m%CvgbRoSNTsW8O?(=&5F1cc6J${l
zf*=G52@R?$ptY?PL__x#LDPyL7Hmo!&%%f|?q@h!$N+0W5a-{I2VZZEhbOC2B7>w|
z<0TYDV!;&^U@TBnSgQssM2f1YDk>yZiYpLNMI=xZQ9(gPL`7n;QBR@d^}5e56;$-k
zqKu2`wIth{?diAE#u_*(0?utJD2dMQYdO5N&68|eSninTTH}da9ggYCQFW!7cD7w@
zK{7!tKx-5bsnS8gn0Sb7Ei|IjL1F182<ax6Y2@E0H+w|ssEgCj96QsAQ#$G)pd^Ao
z3^3_VE^Mo<8AY5<F~2ZwjI5Xx3XrsI!!}~B3YT=VoM8i*&TiPcw}_Es#0*W@xdoIV
z(+J?KX@e7hp*i>Dg+WeamAb6CA!QJ(GepaTxPqpFm8yhCumAv3$f6M-RuF*7(&*GV
zEylUa#5030U0f-|$%gGTwvBe<oVbj0Gda9utl{C9YPH*(*>&4mWFTg(rws>In?s2r
z3=t745u3SAO(!Zd7{DgbmXQ$(*Hqb;E^~FWmwfJ_lXYtqqgkuY`Q+aFIm^Y)t4pW=
z2^k0+W=&GN-)<<X2qi_M5GmF!Kzb6Y5he*XMAL%_aLq$D#){?5UXMdxHL~w|xnNxY
zq(-qRDMD71rD$XT3PeaNK5GP?^Y3Hw5~?x463YujqLRd!mk_9)`3Pq~P>@Lgj1Mvd
z^Q0hlKqkrNOiW?uWGft``2LLTDdfuAhEX$kV$BqTYN%pcLaQZ24*B00Q%u$n)ckIY
zA#am0CPY~jCMG6ZKTZ@-dx#0<Yypgbst6%E>o5!{MS*3Y&u+sF`+GF_B&zqP#X|Y~
z{yw0ZEojuOUC2PVgOb9sjHroPAcKQY8eo&c10a**c+&cGYeDd`$;w{yg9Fk426ze?
z>X_KDZ78%-l#!w`(4-_iO9IGAeP`@%WQz#*Ft)(*vzp?iwpEutzO)Pl6mhIVi)<;T
zCx!7~RwEDDPl=s~q0Kt{SF&w&N%DOB$;R3g-tH*L6oy(PD$cuE<Vbl!K#b1{9{*}~
zXL~Uvd%Lz<3YD~~tg-;Gl_ZK0lL$yowLsE+WVwD?a+$7LEmoAYve^j|gNrd%GCq%Y
z$DTO)O~#Z<$<-}tlxbF$(Oh7a?iu4PHN_7Eyqf0Pt4o6ksiaL=Tk75GTeh_*s3oPS
zq*57-5W>(#mWc!c;Mn68)V(K}i39_vKD3bSIKNj>;Q4Vv<Hs_3muI*TiJhE_HoazA
zNg#k!vh3x_Vwg?|F$n|$>vG8i0`7H2X=QgpWlh!R`y8nd;~^Yo<osB_M82^lh>4mk
z@bY|JLcMH9KJ|tu4)Q*I8e`c7c9Ag0%h}$=#)zR_&%i+<&{$RCBVCj<$?Nb7^V)Rz
zpYM+NkIAA)Tk%Kb6~{5+b`#5cs-i+64U43t7)_&F>Lt9zOxW`Ftg21Gn0*J^)#g-5
z0?$R)8+{VZJaXQ>rj)0I-Ag(%bVbO6;d)-BqQAQpWI;s%I<YF&<CyKX%7OWX$)H27
zoK&J-7iyK`<?_~y3L(8tPfe|2D`tpJr3v^8?sbyF^r`~+msJ>KPSi0b46l||M2b-C
zQv6X>35IXhEjR^;gJ}k=wY+y{*=P+~y2f=yWDAVmI9fZ$-!$8aG^&fi1{D4kCYN3B
znpXr{vcSNZviikmUF{Y*-JiVcn_$t#36QPymXUUP>$!RtqwC+!=vqRG^Yo9W#$vKV
z#h{_qq8oEgZXniF92!h(`;z5eZz<%Z>1iO#a3qeyw38)-AB?>F!l;nhL?Yf?9CULE
z5%?c!M=Ljnl0H3#7#!VQ#qgzW{77@?Y!lz5G>Djg4*-d%5U5BJJnt8Vsfd4hSx~|H
zPQ};pQygq;J9`#11Qm7YlKQMNue)ka9ZDsNrWRGD=r~G!tGNhNnk4d8t)|XbG7N>Y
z7cNASH9efYU5j|mT?j?%K$c~l6%`dZaCr!3k~2ge<M=aSaje97M`ltHq^LI<cC8M}
zclB!UsTwKWFYcm)x0GR<8k0ZKmy}LGq*4ao$hZmELgH)>LJN(=EpA#1R_%(|H|3oI
z5HzEw7jmF+;6!RRwaXk$T^IEf&^VCPiS1nbNdUnv2}LLrk0A#mi7`Hu(N|jgzn<H~
zz_T;Zyv1Z2kIv_-A_Q98l;d{M>oKrzn~1|(jozp6%tKOvBhyM{=Qx*@^Ezx4cYSKI
z_Svw1DbTo=b=z{OAS-tI#4RDm<&$=oaaUR4lF&D;Y-++zgubPxJl(_=o7gt#4=FSu
zW~?&Cj$$ofqfXzROe~aIjARw`_AypGg|;MeE55@NTbepjI7REaTBxBGohdbv4;j>e
zl^O_WR1>C0hP)EJShqr#uY2T6YTWZ2)-Gbi_#B9oQ--OR2&RV;#+s>r!@D-yvn`D+
zn=Gjl8!M7oS*I&qdaHT`q>&|>8@~4tB?jG4OhT1BTUz6V6jMpfywgEXFu5u43=Ric
zdYBcQLLst929#Zm)$qdd8x%fJ^BE!bc6IYfCdAy16(a-Ii#zItHx%t!Z>0^&CPW`g
z9g1Aa)?Sq(3zshrG4Msgv=B31TogHrsOrLgId1Ysk`=8qY@VY%m`hIITouXqM&it;
zO$|#Ct6@bs2--@qIx7;0-%OzTi4Y{_taS9W;|=E98(8mXA7DNt3{1g=frj}1i@744
KC`bh~8;5{P73&xP

literal 2685
zcmV-@3WD`QT4*^jL0KkKS(8lDJOCN2f5iX)Xaz!l|KNXb-@w2B|L{Nn00;;H;0ym3
zI~Fa+f#4*l&?Er)=g}onyI@rphNeK783REyGzm7Ej6~W`L@_h~XvhqhAk{nwO#+!T
z%~MZknrW$~gFt8i00000YM+UrNl*YZ4FRA40000002&E2k`htrsPuy%)M7Jg001KZ
zOln{N0BKD@p`ZZJ02%-Q0002fKma09CWt*uP(33}292lyGyu>BY6C&F0h08qgqX@2
zNMSCZ7Fk3UErKd+YS9s1AHAhO5v@pQ`2M+Z%jjSX92>km1`#(Rml9b(DGfs0Q?+hB
z#h2A^MMOqKbMNnQ?%)4tXYO0=_5An`WG)tV`78~6Ul=Jg)II)}RsH#GjN;lSnpN*P
z6o?T~7Y!guORqz*oNlXTofK9nTI^akazS+qr+rc=88>a%vSQlGpxUp4dD(fwvnuS4
zP-1m=WOFxiXETwgAqPcJi7DmHb~5KM#qZtwg)M^@K$m_elI3M~T9wGf#I`LW_TU)S
z1i7v$gBr0_R8+6`-Lm^KdGB&`qgfiv)4J>Jk~C^JJLKuopkCsoMx_%gW_=~@bAd}`
z3B%@OHS3#F=ETEG7p8U|MP<Cpb&@uVc-$#5o*L6eH#&8oZ1EG(qXk4=M!V{P-9a90
z-Ekx(%(|`2rp6bA6Db4;FjnTg3|?e|Zx1lr=W>qQ%A3ucr35EvUg13RnCOX@r(w&J
zE-4RLi>{cB*3{cmr4hT)^OBj<k+UmF*quzuPHQe0!mPP6U7Uhr4w%f`Wy#EE-sKr{
z>&uoD#l{?vbd#gKA;Abh0pt*b3y1_zRAk8TUcA5t)KNsrAc({e0tAGH)dWyl)`%h@
z`+}h8#SjZNWetzOh&cCi7`1=^)`B66X6xOZ%$M~&d{_z&frk=O3=tJXMHLvZSfHpP
zED%_vQC2Y#R6$lKqYy<B0?48uprWG@Sgcf2%INVqXL-F<I;U+J7p1I|XEx^Qx2t?K
zZd3)FT2(|&Ho2_g@Ygmb%vxCOnKPER-d6`<+MG2PT3M%Mvg>68$&0Ikmfr|m;sd5S
z*4dy1(WDmF5VACmDDWuYm@!B}8c`sfId)|hctkzc=>Z5N0aPl~+?ZBh6jdR!cdA*-
zF>+WolnaMc=;3#a%DY_in1(KIn#`;>m9B;o*x8tJ14TNzqRy40N_U}DbMVqB4TlMR
zH;#(lByGFQf<A;AI2n5_KmY(3$smwGnu8cu8FuO!Po+xNM@&1Zg~joc4Xre`jdpR)
z97Z{roL%x(ZiO<n)0|m#&8;#JGgi}+LDi<otl2Td*KxjcB9NO=PG0CI5V}Z)(ng~t
zmYu4*7;VHrd__qHK_vo+YbIc>O2f6zRi)4X2^k0$%%yd%ZfbA2OLu7&#ntXWD}rq@
zOC;eE)e_R~M{qiwZoBRJnbq6>U7g<KldgwDB}qD1T8=GkOaKE2j0I<q!6&@?*!GgD
zF~Abb3q+!l#F>{6sGZ3OXCN$u7(gULBmvcmA)ysZ$&wX?Vsc<KjI9ab_*u;<(UrFh
zqGs4)%@(jNs-cNmg;q+49O2IxQ%u$n)c743Lf(wTnGr~#F)=dP|FELL?%)a7X#tFY
zs}MqR<(LK*ivr6*p0$P>dfOU$$tt|*;30cGp7**FMXef@uF?=3LCIlRMpQ(t7=wdQ
z8es<HB9M6yohq2@4kc)};Y~A62dGtZL{QCCxq}AMi$y6+RG?KBlnNlGm4Rd=z9Z;u
zu_D4e>@Bc6)^S`^s3CLD)`5Vcjx~r;T7@*k=)Eio#9{PO@`8r+;LE~Pa+9^#-c9ys
zS+>^{WQs#A5*24hD>}@FM1%;;=d-!Z@L}CEteQz)etnB!Qnr;<mOvCGNg{+~$PyEq
zR!t|Jl*h(S6I$V-)orb*V<9CdI2fxL9}C^-<9+&@gG!f!l`U%38dasVR~RLGwsgx)
zZ)aIA2DrAW(%^*D(k85}>)o}jt*uHevWT{dMI_gd!)Lxe&XNQHCOW3Fo0CjcybvG@
zm|tZ8q}QFUABA~>R@En;Q7DpN^W#uraweqBvH*bqPEIpD8LCYPUx4foAPGcb0t5jm
z!dfdSc&&`F>(AOLoL!-<VmzGwk4L<1=^B@O@I{^8_r_?e&ctx!u*Ct$kB4hadY-N%
zOfmBH@?z(V=vS-O9+7A(>gp5MWME|`;tj`)?dZ$*Jrf@|3aDviqvtlA<DhtoMWQ!Z
zP?(|<%|ei2HjM75mg5yOCl|40Qe+8-+CLs{wN6MDcqJomf{h8?j>YLTr8{9YEbV5g
z#E|zs<he^lf0hcwf{Ef4U{$VTfa7hI1M3n@L;IAqN?q3Gm0#1-QZ6imd8SWpma!Hy
zS`z}Mz9G4iII78!7Lk&&*JkEojseiYl;Eg_ZxjrqbG73aI^jDBVNjsVa?ESR9h?yM
zNCw(o3+|dRg5It}O{0+X!8YJcDyMKD!jHm~(=@&CO5TfdurMYJy0KZ;b48O)&-5K|
zYuYzGGz#5GYo2Wx=c#(j!RFb*Pqc(<(bznFP)5-S3}B}|1|hq8Um_8EghUD9PYOkH
z9E!}!+4jnVEkKev&P19P5Pej4_60_PlxJrBtvK)s5BMJxjrHvgB!6}oaTsA8Ql{3A
z$cC;%abAq}+9qOJc!d?HA#kV_9Bvl|sfc$XvY~smLdDndQzkYw{CU<jf(n($p?uaE
zSJ9;>!6cznBNMGpLC*;BT#$u9uyHFk)gF00tbMQ&p{XNTKCZULkiM=$6B23#SC#f$
zR$UgRK!rD<8PQClf5*tTR$_hg<&6S*N+&U=O3^kWSKQU#QZ>xAoc>ctE%pdB*DKll
zHHVJ9CMPOu%jwQ_>{nxmY9p-dW$*mTTyTPisaML>0|+Q`qh4b{u>vK^r-p2~O?ex-
zRnRwq49J|-!5m2j32#a%K%{qwOpV0E_9iuV7t!`<xIhau9<u8z9^5=LIarV)&Ph%Z
z(mdue*ie{~8r&t~cI^TAlgS;FrjGf}T`qysV2?+cR$SX{$a*77C@zb%<61ygt(FJK
zhVPb!>Mnw>Rf)$YAZ%LOGQm=Bt%=j7ZNQ_cgHE^flR_41zZ@gLPSyzP<Kdx&ii<IY
z0bV|KD#sA4#`3r8F$**!wj*vXT&T@N`Py`()<`@dQUX+HA*`ZPK#u(OrFpS&rr9=$
zR80nqjBl{pb`|M5h?J|R1glKa$de5CD|YyFHr%nvrIuDyhzzTtEUeRwvs|j&foUXA
zvqN@WF#=F--N7amYs(F$p5>NXY1a+(u&cZ^ODaQ#1FH_5NUR*pkkSCANPSC6;Kb}z
zEM0+ZWo%xZGPZ=96C`b^7oKsml~1Nc3s-e0ZZnw>bu4ZPnU$}xNWMy=ySjerBrQP$
zHRH8IfRuT!>c>}k@gY*vUR1*|qbuRBkDbci>*tYZC{-4v=)x4)ZecyLTuGgC6vm5c
rrdJgdl5Q>0WQxTFb16`^OuFW9-hqb83k0z0AMtl2Q-ui$G|e->Aa~z$

diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R
index 93f35910..7f3380cd 100644
--- a/R/update-factor-ext.R
+++ b/R/update-factor-ext.R
@@ -245,7 +245,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
           "We encountered the following error creating the new factor:",
           err
         ),
-        type = "err")
+        type = "error")
       })
 
       # browser()
diff --git a/SESSION.md b/SESSION.md
index 0f0edad0..f232def3 100644
--- a/SESSION.md
+++ b/SESSION.md
@@ -11,11 +11,11 @@
 |collate     |en_US.UTF-8                                |
 |ctype       |en_US.UTF-8                                |
 |tz          |Europe/Copenhagen                          |
-|date        |2026-03-24                                 |
+|date        |2026-03-30                                 |
 |rstudio     |2026.01.1+403 Apple Blossom (desktop)      |
 |pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
 |quarto      |1.7.30 @ /usr/local/bin/quarto             |
-|FreesearchR |26.3.4.260324                              |
+|FreesearchR |26.3.5.260330                              |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -53,6 +53,7 @@
 |colorspace        |2.1-2         |2025-09-22 |CRAN (R 4.5.0) |
 |commonmark        |2.0.0         |2025-07-07 |CRAN (R 4.5.0) |
 |crayon            |1.5.3         |2024-06-20 |CRAN (R 4.5.0) |
+|curl              |7.0.0         |2025-08-19 |CRAN (R 4.5.0) |
 |data.table        |1.18.2.1      |2026-01-27 |CRAN (R 4.5.2) |
 |datamods          |1.5.3         |2024-10-02 |CRAN (R 4.5.0) |
 |datawizard        |1.3.0         |2025-10-11 |CRAN (R 4.5.0) |
@@ -83,7 +84,7 @@
 |foreach           |1.5.2         |2022-02-02 |CRAN (R 4.5.0) |
 |foreign           |0.8-91        |2026-01-29 |CRAN (R 4.5.2) |
 |Formula           |1.2-5         |2023-02-24 |CRAN (R 4.5.0) |
-|FreesearchR       |26.3.4        |NA         |NA             |
+|FreesearchR       |26.3.5        |NA         |NA             |
 |fs                |1.6.7         |2026-03-06 |CRAN (R 4.5.2) |
 |gdtools           |0.5.0         |2026-02-09 |CRAN (R 4.5.2) |
 |generics          |0.1.4         |2025-05-09 |CRAN (R 4.5.0) |
@@ -106,6 +107,7 @@
 |htmltools         |0.5.9         |2025-12-04 |CRAN (R 4.5.2) |
 |htmlwidgets       |1.6.4         |2023-12-06 |CRAN (R 4.5.0) |
 |httpuv            |1.6.16        |2025-04-16 |CRAN (R 4.5.0) |
+|httr              |1.4.8         |2026-02-13 |CRAN (R 4.5.2) |
 |IDEAFilter        |0.2.1         |2025-07-29 |CRAN (R 4.5.0) |
 |insight           |1.4.6         |2026-02-04 |CRAN (R 4.5.2) |
 |iterators         |1.0.14        |2022-02-05 |CRAN (R 4.5.0) |
@@ -115,6 +117,7 @@
 |keyring           |1.4.1         |2025-06-15 |CRAN (R 4.5.0) |
 |knitr             |1.51          |2025-12-20 |CRAN (R 4.5.2) |
 |labeling          |0.4.3         |2023-08-29 |CRAN (R 4.5.0) |
+|labelled          |2.16.0        |2025-10-22 |CRAN (R 4.5.0) |
 |later             |1.4.8         |2026-03-05 |CRAN (R 4.5.2) |
 |lattice           |0.22-7        |2025-04-02 |CRAN (R 4.5.2) |
 |lifecycle         |1.0.5         |2026-01-08 |CRAN (R 4.5.2) |
@@ -124,7 +127,6 @@
 |MASS              |7.3-65        |2025-02-28 |CRAN (R 4.5.0) |
 |Matrix            |1.7-4         |2025-08-28 |CRAN (R 4.5.0) |
 |memoise           |2.0.1         |2021-11-26 |CRAN (R 4.5.0) |
-|mgcv              |1.9-4         |2025-11-07 |CRAN (R 4.5.0) |
 |mime              |0.13          |2025-03-17 |CRAN (R 4.5.0) |
 |minqa             |1.2.8         |2024-08-17 |CRAN (R 4.5.0) |
 |mvtnorm           |1.3-2         |2024-11-04 |CRAN (R 4.5.2) |
@@ -148,7 +150,6 @@
 |pkgload           |1.5.0         |2026-02-03 |CRAN (R 4.5.2) |
 |plyr              |1.8.9         |2023-10-02 |CRAN (R 4.5.0) |
 |polyclip          |1.10-7        |2024-07-23 |CRAN (R 4.5.0) |
-|polylabelr        |1.0.0         |2026-01-19 |CRAN (R 4.5.2) |
 |pracma            |2.4.6         |2025-10-22 |CRAN (R 4.5.0) |
 |processx          |3.8.6         |2025-02-21 |CRAN (R 4.5.0) |
 |promises          |1.5.0         |2025-11-01 |CRAN (R 4.5.0) |
diff --git a/inst/translations/translation_da.csv b/inst/translations/translation_da.csv
index ce9abc8e..4f3752bd 100644
--- a/inst/translations/translation_da.csv
+++ b/inst/translations/translation_da.csv
@@ -55,7 +55,6 @@
 "Imported data","Importeret data"
 "www/intro.md","www/intro.md"
 "Choose your data","Vælg dine data"
-"Factor variable to reorder:","Kategoriske variabel der skal ændres:"
 "Sort by levels","Sorter efter niveauer"
 "Sort by count","Sorter efter antal"
 "Update factor variable","Updater faktor-variabel"
@@ -148,16 +147,12 @@
 "Import data from REDCap","Importér data fra REDCap"
 "REDCap server","REDCap-server"
 "Web address","Serveradresse"
-"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Adressen skal være som 'https://redcap.your.institution/' eller 'https://your.institution/redcap/'"
 "API token","API-nøgle"
-"The token is a string of 32 numbers and letters.","En API-nøgle består af ialt 32 tal og bogstaver."
 "Connect","Forbind"
 "Data import parameters","Data import parameters"
-"Select fields/variables to import and click the funnel to apply optional filters","Vælg variabler, der skal importeres og tryk på tragten for at anvende valgfrie filtre"
 "Import","Import"
 "Click to see data dictionary","Tryk for at se metadata (Data Dictionary)"
 "Connected to server!","Forbindelse til serveren oprettet!"
-"The {data_rv$info$project_title} project is loaded.","{data_rv$info$project_title}-projektet er forbundet."
 "Data dictionary","Data dictionary"
 "Preview:","Forsmag:"
 "Imported data set","Importeret datasæt"
@@ -165,8 +160,6 @@
 "Specify the data format","Specificér dataformatet"
 "Fill missing values?","Skal manglende observationer udfyldes?"
 "Requested data was retrieved!","Det udvalgte data blev hentet!"
-"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data er hentet, men det ser ud til kun at indeholde ID-variablen. Du skal kontakte din REDCap-administrator og sikre dig at du har adgang til faktisk at hente de udvalgte data."
-"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data er hentet, men det ser ud til kun at indeholde nogle af de udvalgte variabler. Du skal kontakte din REDCap-administrator og sikre dig at du har adgang til faktisk at hente de udvalgte data."
 "Click to see the imported data","Tryk for at se de importerede data"
 "Regression table","Regressionstabel"
 "Import a dataset from an environment","Importer et datasæt fra et kodemiljø"
@@ -291,7 +284,6 @@
 "No data present.","Ingen data tilstede."
 "You have provided a complete dataset with no missing values.","Data er uden manglende observationer."
 "Start by loading data.","Start med at vælge data."
-"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)"
 "Data classes and missing observations","Data classes and missing observations"
 "We encountered the following error showing missingness:","We encountered the following error showing missingness:"
 "Please confirm data reset!","Please confirm data reset!"
@@ -323,3 +315,9 @@
 "Settings","Settings"
 "Create new factor","Create new factor"
 "Choose color palette","Choose color palette"
+"Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
+"Drop empty","Drop empty"
+"Choose variable:","Choose variable:"
+"An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
+"An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
+"Likert diagram","Likert diagram"
diff --git a/inst/translations/translation_sw.csv b/inst/translations/translation_sw.csv
index 96a7a109..a375e0a5 100644
--- a/inst/translations/translation_sw.csv
+++ b/inst/translations/translation_sw.csv
@@ -55,7 +55,6 @@
 "Imported data","Data iliyoingizwa"
 "www/intro.md","www/intro.md"
 "Choose your data","Chagua data yako"
-"Factor variable to reorder:","Kigezo cha vipengele ili kupanga upya:"
 "Sort by levels","Panga kwa viwango"
 "Sort by count","Panga kwa hesabu"
 "Update factor variable","Sasisha kigezo cha kipengele"
@@ -148,16 +147,12 @@
 "Import data from REDCap","Ingiza data kutoka REDCap"
 "REDCap server","Seva ya REDCap"
 "Web address","Anwani ya wavuti"
-"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Muundo unapaswa kuwa 'https://redcap.your.institution/' au 'https://your.institution/redcap/'"
 "API token","Tokeni ya API"
-"The token is a string of 32 numbers and letters.","Tokeni ni mfuatano wa nambari na herufi 32."
 "Connect","Unganisha"
 "Data import parameters","Vigezo vya kuingiza data"
-"Select fields/variables to import and click the funnel to apply optional filters","Chagua sehemu/vigezo vya kuingiza na ubofye faneli ili kutumia vichujio vya hiari"
 "Import","Ingiza"
 "Click to see data dictionary","Bofya ili kuona kamusi ya data"
 "Connected to server!","Imeunganishwa na seva!"
-"The {data_rv$info$project_title} project is loaded.","Mradi wa {data_rv$info$project_title} umepakiwa."
 "Data dictionary","Kamusi ya data"
 "Preview:","Hakikisho:"
 "Imported data set","Seti ya data iliyoingizwa"
@@ -165,8 +160,6 @@
 "Specify the data format","Bainisha umbizo la data"
 "Fill missing values?","Jaza thamani zinazokosekana?"
 "Requested data was retrieved!","Data iliyoombwa ilipatikana!"
-"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data imerejeshwa, lakini inaonekana ni kitambulisho pekee kilichorejeshwa kutoka kwa seva. Tafadhali wasiliana na msimamizi wako wa REDCap kama una ruhusa zinazohitajika kwa ufikiaji wa data."
-"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data imerejeshwa, lakini inaonekana kama si sehemu zote zilizoombwa zilizorejeshwa kutoka kwa seva. Tafadhali wasiliana na msimamizi wako wa REDCap kama una ruhusa zinazohitajika kwa ufikiaji wa data."
 "Click to see the imported data","Bofya ili kuona data iliyoingizwa"
 "Regression table","Jedwali la urejeshaji"
 "Import a dataset from an environment","Ingiza seti ya data kutoka kwa mazingira"
@@ -291,7 +284,6 @@
 "No data present.","No data present."
 "You have provided a complete dataset with no missing values.","You have provided a complete dataset with no missing values."
 "Start by loading data.","Start by loading data."
-"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)"
 "Data classes and missing observations","Data classes and missing observations"
 "We encountered the following error showing missingness:","We encountered the following error showing missingness:"
 "Please confirm data reset!","Please confirm data reset!"
@@ -323,3 +315,9 @@
 "Settings","Settings"
 "Create new factor","Create new factor"
 "Choose color palette","Choose color palette"
+"Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
+"Drop empty","Drop empty"
+"Choose variable:","Choose variable:"
+"An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
+"An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
+"Likert diagram","Likert diagram"
diff --git a/renv.lock b/renv.lock
index 567601cc..96709a25 100644
--- a/renv.lock
+++ b/renv.lock
@@ -35,12 +35,12 @@
     },
     "DHARMa": {
       "Package": "DHARMa",
-      "Version": "0.4.6",
+      "Version": "0.4.7",
       "Source": "Repository",
       "Title": "Residual Diagnostics for Hierarchical (Multi-Level / Mixed) Regression Models",
-      "Date": "2022-09-08",
-      "Authors@R": "c(person(\"Florian\", \"Hartig\", email = \"florian.hartig@biologie.uni-regensburg.de\", role = c(\"aut\", \"cre\"), comment=c(ORCID=\"0000-0002-6255-9059\")), person(\"Lukas\", \"Lohse\", role = \"ctb\"))",
-      "Description": "The 'DHARMa' package uses a simulation-based approach to create readily interpretable scaled (quantile) residuals for fitted (generalized) linear mixed models. Currently supported are linear and generalized linear (mixed) models from 'lme4' (classes 'lmerMod', 'glmerMod'), 'glmmTMB' 'GLMMadaptive' and 'spaMM', generalized additive models ('gam' from 'mgcv'), 'glm' (including 'negbin' from 'MASS', but excluding quasi-distributions) and 'lm' model classes. Moreover, externally created simulations, e.g. posterior predictive simulations from Bayesian software such as 'JAGS', 'STAN', or 'BUGS' can be processed as well. The resulting residuals are standardized to values between 0 and 1 and can be interpreted as intuitively as residuals from a linear regression. The package also provides a number of plot and test functions for typical model misspecification problems, such as over/underdispersion, zero-inflation, and residual spatial and temporal autocorrelation.",
+      "Date": "2024-10-16",
+      "Authors@R": "c(person(\"Florian\", \"Hartig\", email = \"florian.hartig@biologie.uni-regensburg.de\", role = c(\"aut\", \"cre\"), comment=c(ORCID=\"0000-0002-6255-9059\")), person(\"Lukas\", \"Lohse\", role = \"ctb\"), person(\"Melina\", \"de Souza leite\", role = \"ctb\"))",
+      "Description": "The 'DHARMa' package uses a simulation-based approach to create readily interpretable scaled (quantile) residuals for fitted (generalized) linear mixed models. Currently supported are linear and generalized linear (mixed) models from 'lme4' (classes 'lmerMod', 'glmerMod'), 'glmmTMB', 'GLMMadaptive', and 'spaMM'; phylogenetic  linear models from 'phylolm' (classes 'phylolm' and 'phyloglm'); generalized additive  models ('gam' from 'mgcv'); 'glm' (including 'negbin' from 'MASS', but excluding quasi-distributions) and 'lm' model classes. Moreover, externally created simulations, e.g. posterior predictive simulations from Bayesian software such as 'JAGS', 'STAN', or 'BUGS' can be processed as well. The resulting residuals are standardized to values between 0 and 1 and can be interpreted as intuitively as residuals from a linear regression. The package also provides a number of plot and test functions for typical model misspecification problems, such as over/underdispersion, zero-inflation, and residual spatial, phylogenetic and temporal autocorrelation.",
       "Depends": [
         "R (>= 3.0.2)"
       ],
@@ -59,7 +59,7 @@
       ],
       "Suggests": [
         "knitr",
-        "testthat",
+        "testthat (>= 3.0.0)",
         "rmarkdown",
         "KernSmooth",
         "sfsmisc",
@@ -68,7 +68,8 @@
         "mgcViz (>= 0.1.9)",
         "spaMM (>= 3.2.0)",
         "GLMMadaptive",
-        "glmmTMB (>= 1.1.2.3)"
+        "glmmTMB (>= 1.1.2.3)",
+        "phylolm (>= 2.6.5)"
       ],
       "Enhances": [
         "phyr",
@@ -80,11 +81,12 @@
       "URL": "http://florianhartig.github.io/DHARMa/",
       "LazyData": "TRUE",
       "BugReports": "https://github.com/florianhartig/DHARMa/issues",
-      "RoxygenNote": "7.2.1",
+      "RoxygenNote": "7.3.2",
       "VignetteBuilder": "knitr",
       "Encoding": "UTF-8",
+      "Config/testthat/edition": "3",
       "NeedsCompilation": "no",
-      "Author": "Florian Hartig [aut, cre] (<https://orcid.org/0000-0002-6255-9059>), Lukas Lohse [ctb]",
+      "Author": "Florian Hartig [aut, cre] (<https://orcid.org/0000-0002-6255-9059>), Lukas Lohse [ctb], Melina de Souza leite [ctb]",
       "Maintainer": "Florian Hartig <florian.hartig@biologie.uni-regensburg.de>",
       "Repository": "CRAN"
     },
@@ -2345,7 +2347,7 @@
     },
     "datamods": {
       "Package": "datamods",
-      "Version": "1.5.2",
+      "Version": "1.5.3",
       "Source": "Repository",
       "Title": "Modules to Import and Manipulate Data in 'Shiny'",
       "Authors@R": "c(person(given = \"Victor\", family = \"Perrier\", role = c(\"aut\", \"cre\", \"cph\"), email = \"victor.perrier@dreamrs.fr\"), person(given = \"Fanny\", family = \"Meyer\", role = \"aut\"), person(given = \"Samra\", family = \"Goumri\", role = \"aut\"), person(given = \"Zauad Shahreer\", family = \"Abeer\", role = \"aut\", email = \"shahreyar.abeer@gmail.com\"), person(given = \"Eduard\", family = \"Szöcs\", role = \"ctb\", email = \"eduardszoecs@gmail.com\") )",
@@ -8357,7 +8359,7 @@
     },
     "shinybusy": {
       "Package": "shinybusy",
-      "Version": "0.3.2",
+      "Version": "0.3.3",
       "Source": "Repository",
       "Title": "Busy Indicators and Notifications for 'Shiny' Applications",
       "Authors@R": "c(person(\"Fanny\", \"Meyer\", role = \"aut\"), person(\"Victor\", \"Perrier\", email = \"victor.perrier@dreamrs.fr\", role = c(\"aut\", \"cre\")), person(\"Silex Technologies\", comment = \"https://www.silex-ip.com\", role = \"fnd\"))",
@@ -8370,8 +8372,8 @@
         "jsonlite",
         "htmlwidgets"
       ],
-      "RoxygenNote": "7.2.3",
-      "URL": "https://github.com/dreamRs/shinybusy",
+      "RoxygenNote": "7.3.1",
+      "URL": "https://github.com/dreamRs/shinybusy, https://dreamrs.github.io/shinybusy/",
       "BugReports": "https://github.com/dreamRs/shinybusy/issues",
       "Suggests": [
         "testthat",

From 75f2ae07b713fb1b12c1caf0b7423c6d6e7f57bf Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 30 Mar 2026 20:26:09 +0200
Subject: [PATCH 10/10] new version

---
 app_docker/app.R                           | 1163 +++++++++++++++-----
 app_docker/renv.lock                       |   26 +-
 app_docker/translations/translation_da.csv |   14 +-
 app_docker/translations/translation_sw.csv |   14 +-
 inst/apps/FreesearchR/app.R                | 1163 +++++++++++++++-----
 5 files changed, 1772 insertions(+), 608 deletions(-)

diff --git a/app_docker/app.R b/app_docker/app.R
index c18c6f99..31c047b8 100644
--- a/app_docker/app.R
+++ b/app_docker/app.R
@@ -1,7 +1,7 @@
 
 
 ########
-#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//Rtmpn21sEQ/filec83e64988776.R 
+#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//Rtmp1OaGW3/file656737f80bdf.R 
 ########
 
 i18n_path <- here::here("translations")
@@ -64,7 +64,7 @@ i18n$set_translation_language("en")
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'26.3.4'
+app_version <- function()'26.3.5'
 
 
 ########
@@ -84,7 +84,10 @@ app_version <- function()'26.3.4'
 #' @examples
 #' mtcars |> baseline_table()
 #' mtcars |> baseline_table(fun.args = list(by = "gear"))
-baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) {
+baseline_table <- function(data,
+                           fun.args = NULL,
+                           fun = gtsummary::tbl_summary,
+                           vars = NULL) {
   out <- do.call(fun, c(list(data = data), fun.args))
   return(out)
 }
@@ -110,7 +113,15 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
 #' mtcars |> create_baseline(by.var = "gear", detail_level = "extended",type = list(gtsummary::all_dichotomous() ~ "categorical"),theme="nejm")
 #'
 #' create_baseline(default_parsing(mtcars), by.var = "am", add.p = FALSE, add.overall = FALSE, theme = "lancet")
-create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, add.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon"), detail_level = c("minimal", "extended")) {
+create_baseline <- function(data,
+                            ...,
+                            by.var,
+                            add.p = FALSE,
+                            add.diff = FALSE,
+                            add.overall = FALSE,
+                            theme = c("jama", "lancet", "nejm", "qjecon"),
+                            detail_level = c("minimal", "extended"),
+                            drop_empty = FALSE) {
   theme <- match.arg(theme)
 
   detail_level <- match.arg(detail_level)
@@ -137,31 +148,28 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, ad
   if (!any(hasName(args, c("type", "statistic")))) {
     if (detail_level == "extended") {
       args <-
-        modifyList(
-          args,
-          list(
-            type = list(gtsummary::all_continuous() ~ "continuous2",
-                        gtsummary::all_dichotomous() ~ "categorical"),
-            statistic = list(gtsummary::all_continuous() ~ c(
-              "{median} ({p25}, {p75})",
-              "{mean} ({sd})",
-              "{min}, {max}"))
+        modifyList(args, list(
+          type = list(
+            gtsummary::all_continuous() ~ "continuous2",
+            gtsummary::all_dichotomous() ~ "categorical"
+          ),
+          statistic = list(
+            gtsummary::all_continuous() ~ c("{median} ({p25}, {p75})", "{mean} ({sd})", "{min}, {max}")
           )
-        )
+        ))
     }
   }
 
-  parameters <- list(
-    data = data,
-    fun.args = purrr::list_flatten(list(by = by.var, args))
-  )
+  if (isTRUE(drop_empty)) {
+    ## Drops empty levels if minimal
+    data <- data |> REDCapCAST::fct_drop()
+  }
+
+  parameters <- list(data = data, fun.args = purrr::list_flatten(list(by = by.var, args)))
 
 
   # browser()
-  out <- do.call(
-    baseline_table,
-    parameters
-  )
+  out <- do.call(baseline_table, parameters)
 
 
   if (!is.null(by.var)) {
@@ -1121,7 +1129,7 @@ vectorSelectInput <- function(inputId,
 colorSelectInput <- function(inputId,
                              label,
                              choices,
-                             selected = "",
+                             selected = NULL,
                              previews = 4,
                              ...,
                              placeholder = "") {
@@ -1157,31 +1165,43 @@ colorSelectInput <- function(inputId,
 
   choices_new <- stats::setNames(vals, labels)
 
+  if (is.null(selected) || selected == "") {
+    selected <- vals[[1]]
+  }
+
   shiny::selectizeInput(
     inputId  = inputId,
     label    = label,
     choices  = choices_new,
     selected = selected,
     ...,
-    options  = list(
+    options = list(
       render = I(
         "{
-        option: function(item, escape) {
-          item.data = JSON.parse(item.label);
-          return '<div style=\"padding:3px 12px\">' +
-                   '<div><strong>' + escape(item.data.name) + '</strong></div>' +
-                   (item.data.label != '' ? '<div><small>' + escape(item.data.label) + '</small></div>' : '') +
-                   '<div style=\"margin-top:4px\">' + item.data.swatch + '</div>' +
-                 '</div>';
-        },
-        item: function(item, escape) {
-          item.data = JSON.parse(item.label);
-          return '<div style=\"display:flex;align-items:center;gap:6px\">' +
-                   '<span>' + escape(item.data.name) + '</span>' +
-                   item.data.swatch +
-                 '</div>';
-        }
-      }"
+    option: function(item, escape) {
+      item.data = JSON.parse(item.label);
+      return '<div style=\"padding:3px 12px\">' +
+               '<div><strong>' + escape(item.data.name) + '</strong></div>' +
+               (item.data.label != '' ? '<div><small>' + escape(item.data.label) + '</small></div>' : '') +
+               '<div style=\"margin-top:4px\">' + item.data.swatch + '</div>' +
+             '</div>';
+    },
+    item: function(item, escape) {
+      item.data = JSON.parse(item.label);
+      return '<div style=\"display:flex;align-items:center;gap:6px\">' +
+               '<span>' + escape(item.data.name) + '</span>' +
+               item.data.swatch +
+             '</div>';
+    }
+  }"
+      ),
+      onInitialize = I(
+        "function() {
+    var self = this;
+    self.$control_input.prop('readonly', true);
+    self.$control_input.css('cursor', 'default');
+    self.$control.css('cursor', 'pointer');
+  }"
       )
     )
   )
@@ -1862,7 +1882,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
             rlang::exec(cut_var, !!!parameters)
           },
           error = function(err) {
-            showNotification(paste("We encountered the following error creating the new factor:", err), type = "err")
+            showNotification(paste("We encountered the following error creating the new factor:", err), type = "error")
           }
         )
 
@@ -2468,7 +2488,7 @@ data_visuals_server <- function(id,
 
       shiny::observeEvent(input$act_plot, {
         if (NROW(data()) > 0) {
-          tryCatch({
+            tryCatch({
             parameters <- list(
               type = rv$plot.params()[["fun"]],
               pri = input$primary,
@@ -2494,7 +2514,7 @@ data_visuals_server <- function(id,
           #   showNotification(paste0(warn), type = "warning")
           # },
           error = function(err) {
-            showNotification(paste0(err), type = "err")
+            showNotification(paste0(err), type = "error")
           })
         }
       }, ignoreInit = TRUE)
@@ -2717,6 +2737,18 @@ supported_plots <- function() {
       secondary.max = 4,
       tertiary.type = c("dichotomous"),
       secondary.extra = NULL
+    ),
+    plot_euler = list(
+      fun = "plot_likert",
+      descr = i18n$t("Likert diagram"),
+      note = i18n$t(
+        "Plot survey results"
+      ),
+      primary.type = c("dichotomous", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = TRUE,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = NULL
     )
   )
 }
@@ -4303,8 +4335,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 <-
   #
@@ -4914,12 +4946,63 @@ data_types <- function() {
   )
 }
 
+non_character_cols <- function(df) {
+  if (shiny::is.reactive(df)) df <- df()
+  df[, !sapply(df, is.character), drop = FALSE]
+}
+
+apply_idea_filter <- function(filtered_reactive, df_target, env = parent.frame()) {
+  # If this ever brakes, the solution will have to be to modify the original filter function
+  if (shiny::is.reactive(df_target)) df_target <- df_target()
+
+  result      <- if (shiny::is.reactive(filtered_reactive)) filtered_reactive() else filtered_reactive
+  filter_code <- attr(result, "code")
+
+  if (is.null(filter_code)) return(df_target)
+
+  deparsed <- paste(deparse(filter_code), collapse = "")
+
+  if (is.symbol(filter_code) || !grepl("filter(", deparsed, fixed = TRUE)) {
+    return(df_target)
+  }
+
+  extract_filters <- function(code) {
+    filters <- list()
+    while (!is.symbol(code) && deparse(code[[1]]) == "%>%") {
+      rhs <- code[[3]]
+      if (deparse(rhs[[1]]) == "filter") {
+        filters <- c(list(rhs), filters)
+      }
+      code <- code[[2]]
+    }
+    if (!is.symbol(code) && deparse(code[[1]]) == "filter") {
+      filters <- c(list(code), filters)
+    }
+    filters
+  }
+
+  tryCatch({
+    out <- df_target
+    for (f in extract_filters(filter_code)) {
+      args <- lapply(rlang::call_args(f), function(arg) {
+        rlang::new_quosure(arg, env = env)
+      })
+      out <- dplyr::filter(out, !!!args)
+    }
+    out
+  },
+  error = function(e) {
+    warning("Could not apply filter: ", conditionMessage(e))
+    df_target
+  })
+}
+
 
 ########
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v26.3.4-260324'
+hosted_version <- function()'v26.3.5-260330'
 
 
 ########
@@ -5698,7 +5781,7 @@ import_file_server <- function(id,
       #     showNotification(warn, type = "warning")
       # },
       error = function(err) {
-        showNotification(err, type = "err")
+        showNotification(err, type = "error")
       })
     })
 
@@ -5715,7 +5798,7 @@ import_file_server <- function(id,
           minBodyHeight = 250
         )
       }, error = function(err) {
-        showNotification(err, type = "err")
+        showNotification(err, type = "error")
       })
     })
 
@@ -5830,7 +5913,7 @@ import_xls <- function(file, sheet, skip, na.strings) {
   #   showNotification(paste0(warn), type = "warning")
   # },
   error = function(err) {
-    showNotification(paste0(err), type = "err")
+    showNotification(paste0(err), type = "error")
   })
 }
 
@@ -5858,7 +5941,7 @@ import_ods <- function(file, sheet, skip, na.strings) {
   #   showNotification(paste0(warn), type = "warning")
   # },
   error = function(err) {
-    showNotification(paste0(err), type = "err")
+    ?showNotification(paste0(err), type = "error")
   })
 }
 
@@ -6701,7 +6784,7 @@ data_missings_server <- function(id, data, max_level = 20, ...) {
             out <- do.call(compare_missings, modifyList(parameters, list(data = df_tbl)))
           })
         }, error = function(err) {
-          showNotification(paste0("Error: ", err), type = "err")
+          showNotification(paste0("Error: ", err), type = "error")
         })
 
         if (is.null(input$missings_var) ||
@@ -7406,6 +7489,62 @@ vertical_stacked_bars <- function(data,
 }
 
 
+########
+#### Current file: /Users/au301842/FreesearchR/R//plot_likert.R 
+########
+
+#' Nice horizontal bar plot centred on the central category
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @name data-plots
+#'
+#' @examples
+#' mtcars |> plot_likert(pri = "carb", sec = "cyl")
+#' mtcars |> plot_likert(pri = "carb", sec = "cyl", ter="am")
+#' mtcars |> plot_likert(pri = "cyl",color.palette="Blues")
+#' mtcars |> plot_likert(pri = "carb", sec = NULL,color.palette="Magma")
+#' mtcars |> plot_likert(pri = "carb", sec = c("cyl","am"),color.palette="Viridis")
+plot_likert <- function(data,
+                        pri,
+                        sec = NULL,
+                        ter = NULL,
+                        color.palette = "viridis") {
+  if (!is.null(ter)) {
+    ds <- split(data, data[ter])
+  } else {
+    ds <- list(data)
+  }
+  out <- lapply(ds, \(.x) {
+    .x[c(pri, sec)] |>
+      # na.omit() |>
+      plot_likert_single(color.palette = color.palette)
+  })
+
+  wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")))
+}
+
+
+plot_likert_single <- function(data, color.palette = "viridis") {
+  ggstats::gglikert(data = data) +
+    scale_fill_generate(palette=color.palette)+
+    ggplot2::theme(
+      # legend.position = "none",
+      # panel.grid.major = element_blank(),
+      # panel.grid.minor = element_blank(),
+      # axis.text.y = ggplot2::element_blank(),
+      # axis.title.y = ggplot2::element_blank(),
+      text = ggplot2::element_text(size = 12)
+      # axis.text = ggplot2::element_blank(),
+      # plot.title = element_blank(),
+      # panel.background = ggplot2::element_rect(fill = "white"),
+      # plot.background = ggplot2::element_rect(fill = "white"),
+      # panel.border = ggplot2::element_blank()
+    )
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//plot_ridge.R 
 ########
@@ -7990,10 +8129,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
   ns <- shiny::NS(id)
 
   if (isTRUE(title)) {
-    title <- shiny::tags$h4(
-      i18n$t("Import data from REDCap"),
-      class = "redcap-module-title"
-    )
+    title <- shiny::tags$h4(i18n$t("Import data from REDCap"), class = "redcap-module-title")
   }
 
   server_ui <- shiny::tagList(
@@ -8004,7 +8140,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       value = if_not_missing(url, "https://redcap.your.institution/"),
       width = "100%"
     ),
-    shiny::helpText(i18n$t("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'")),
+    shiny::helpText(
+      i18n$t(
+        "Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
+      )
+    ),
     shiny::br(),
     shiny::br(),
     shiny::passwordInput(
@@ -8013,7 +8153,9 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       value = "",
       width = "100%"
     ),
-    shiny::helpText(i18n$t("The token is a string of 32 numbers and letters.")),
+    shiny::helpText(i18n$t(
+      "The token is a string of 32 numbers and letters."
+    )),
     shiny::br(),
     shiny::br(),
     shiny::actionButton(
@@ -8030,7 +8172,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shinyWidgets::alert(
         id = ns("connect-result"),
         status = "info",
-        tags$p(phosphoricons::ph("info", weight = "bold"), i18n$t("Please fill in web address and API token, then press 'Connect'."))
+        tags$p(
+          phosphoricons::ph("info", weight = "bold"),
+          i18n$t("Please fill in web address and API token, then press 'Connect'.")
+        )
       ),
       dismissible = TRUE
     ),
@@ -8043,14 +8188,18 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shiny::uiOutput(outputId = ns("arms")),
       shiny::textInput(
         inputId = ns("filter"),
-        label = i18n$t("Optional filter logic (e.g., ⁠[gender] = 'female')"
-      ))
+        label = i18n$t("Optional filter logic (e.g., ⁠[gender] = 'female')")
+      ),
+      uiOutput(ns("filter_feedback"))
     )
 
   params_ui <-
     shiny::tagList(
       shiny::tags$h4(i18n$t("Data import parameters")),
       shiny::tags$div(
+        ####
+        #### All below was deactivated to deactivate filtering
+        ####
         style = htmltools::css(
           display = "grid",
           gridTemplateColumns = "1fr 50px",
@@ -8075,7 +8224,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
           )
         )
       ),
-      shiny::helpText(i18n$t("Select fields/variables to import and click the funnel to apply optional filters")),
+      shiny::helpText(
+        i18n$t(
+          "Select fields/variables to import and click the funnel to apply optional filters"
+        )
+      ),
       shiny::tags$br(),
       shiny::tags$br(),
       shiny::uiOutput(outputId = ns("data_type")),
@@ -8094,7 +8247,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
         shinyWidgets::alert(
           id = ns("retrieved-result"),
           status = "info",
-          tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
+          tags$p(
+            phosphoricons::ph("info", weight = "bold"),
+            "Please specify data to download, then press 'Import'."
+          )
         ),
         dismissible = TRUE
       )
@@ -8105,11 +8261,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
     title = title,
     server_ui,
     # shiny::uiOutput(ns("params_ui")),
-    shiny::conditionalPanel(
-      condition = "output.connect_success == true",
-      params_ui,
-      ns = ns
-    ),
+    shiny::conditionalPanel(condition = "output.connect_success == true", params_ui, ns = ns),
     shiny::br()
   )
 }
@@ -8134,14 +8286,19 @@ m_redcap_readServer <- function(id) {
       dd_list = NULL,
       data = NULL,
       rep_fields = NULL,
-      code = NULL
+      code = NULL,
+      filter_valid = NULL
     )
 
     shiny::observeEvent(list(input$api, input$uri), {
       shiny::req(input$api)
       shiny::req(input$uri)
       if (!is.null(input$uri)) {
-        uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
+        uri <- paste0(ifelse(
+          endsWith(input$uri, "/"),
+          input$uri,
+          paste0(input$uri, "/")
+        ), "api/")
       } else {
         uri <- input$uri
       }
@@ -8155,75 +8312,68 @@ m_redcap_readServer <- function(id) {
     })
 
 
-    tryCatch(
-      {
-        shiny::observeEvent(
-          list(
-            input$data_connect
-          ),
-          {
-            shiny::req(input$api)
-            shiny::req(data_rv$uri)
+    tryCatch({
+      shiny::observeEvent(list(input$data_connect), {
+        shiny::req(input$api)
+        shiny::req(data_rv$uri)
 
-            parameters <- list(
-              redcap_uri = data_rv$uri,
-              token = input$api
-            )
+        parameters <- list(redcap_uri = data_rv$uri, token = input$api)
 
-            # browser()
-            shiny::withProgress(
-              {
-                imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
-              },
-              message = paste("Connecting to", data_rv$uri)
-            )
+        # browser()
+        shiny::withProgress({
+          imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters),
+                          silent = TRUE)
+        }, message = paste("Connecting to", data_rv$uri))
 
-            ## TODO: Simplify error messages
-            if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
-              if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
-                mssg <- imported$raw_text
-              } else {
-                mssg <- attr(imported, "condition")$message
-              }
+        ## TODO: Simplify error messages
+        if (inherits(imported, "try-error") ||
+            NROW(imported) < 1 ||
+            ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
+          if (ifelse(is.list(imported),
+                     !isTRUE(imported$success),
+                     FALSE)) {
+            mssg <- imported$raw_text
+          } else {
+            mssg <- attr(imported, "condition")$message
+          }
 
-              datamods:::insert_error(mssg = mssg, selector = "connect")
-              data_rv$dd_status <- "error"
-              data_rv$dd_list <- NULL
-            } else if (isTRUE(imported$success)) {
-              data_rv$dd_status <- "success"
+          datamods:::insert_error(mssg = mssg, selector = "connect")
+          data_rv$dd_status <- "error"
+          data_rv$dd_list <- NULL
+        } else if (isTRUE(imported$success)) {
+          data_rv$dd_status <- "success"
 
-              data_rv$info <- REDCapR::redcap_project_info_read(
-                redcap_uri = data_rv$uri,
-                token = input$api
-              )$data
+          data_rv$info <- REDCapR::redcap_project_info_read(redcap_uri = data_rv$uri, token = input$api)$data
 
-              datamods:::insert_alert(
-                selector = ns("connect"),
-                status = "success",
-                include_data_alert(
-                  see_data_text = i18n$t("Click to see data dictionary"),
-                  dataIdName = "see_dd",
-                  extra = tags$p(
-                    tags$b(phosphoricons::ph("check", weight = "bold"), i18n$t("Connected to server!")),
-                    glue::glue(i18n$t("The {data_rv$info$project_title} project is loaded."))
-                  ),
-                  btn_show_data = TRUE
+          datamods:::insert_alert(
+            selector = ns("connect"),
+            status = "success",
+            include_data_alert(
+              see_data_text = i18n$t("Click to see data dictionary"),
+              dataIdName = "see_dd",
+              extra = tags$p(
+                tags$b(
+                  phosphoricons::ph("check", weight = "bold"),
+                  i18n$t("Connected to server!")
+                ),
+                glue::glue(
+                  i18n$t(
+                    "The {data_rv$info$project_title} project is loaded."
+                  )
                 )
-              )
+              ),
+              btn_show_data = TRUE
+            )
+          )
 
-              data_rv$dd_list <- imported
-            }
-          },
-          ignoreInit = TRUE
-        )
-      },
-      warning = function(warn) {
-        showNotification(paste0(warn), type = "warning")
-      },
-      error = function(err) {
-        showNotification(paste0(err), type = "err")
-      }
-    )
+          data_rv$dd_list <- imported
+        }
+      }, ignoreInit = TRUE)
+    }, warning = function(warn) {
+      showNotification(paste0(warn), type = "warning")
+    }, error = function(err) {
+      showNotification(paste0(err), type = "error")
+    })
 
     output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
     shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
@@ -8254,10 +8404,7 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$api)
       shiny::req(data_rv$uri)
 
-      REDCapR::redcap_event_read(
-        redcap_uri = data_rv$uri,
-        token = input$api
-      )$data
+      REDCapR::redcap_event_read(redcap_uri = data_rv$uri, token = input$api)$data
     })
 
     output$fields <- shiny::renderUI({
@@ -8267,7 +8414,7 @@ m_redcap_readServer <- function(id) {
         label = i18n$t("Select fields/variables to import:"),
         choices = purrr::pluck(data_rv$dd_list, "data") |>
           dplyr::select(field_name, form_name) |>
-          (\(.x){
+          (\(.x) {
             split(.x$field_name, REDCapCAST::as_factor(.x$form_name))
           })(),
         updateOn = "change",
@@ -8300,14 +8447,10 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$data_type)
 
       ## Get repeated field
-      data_rv$rep_fields <- data_rv$dd_list$data$field_name[
-        data_rv$dd_list$data$form_name %in% repeated_instruments(
-          uri = data_rv$uri,
-          token = input$api
-        )
-      ]
+      data_rv$rep_fields <- data_rv$dd_list$data$field_name[data_rv$dd_list$data$form_name %in% repeated_instruments(uri = data_rv$uri, token = input$api)]
 
-      if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
+      if (input$data_type == "long" &&
+          isTRUE(any(input$fields %in% data_rv$rep_fields))) {
         vectorSelectInput(
           inputId = ns("fill"),
           label = i18n$t("Fill missing values?"),
@@ -8343,12 +8486,48 @@ m_redcap_readServer <- function(id) {
       }
     })
 
+
+    filter_validation <- reactive({
+      val <- trimws(input$filter)
+      if (nchar(val) == 0)
+        return(NULL)
+      validate_redcap_filter(val, purrr::pluck(data_rv$dd_list, "data"))
+    })
+
+    output$filter_feedback <- renderUI({
+      result <- filter_validation()
+      if (is.null(result)) {
+        data_rv$filter_valid <- NULL
+        return(NULL)
+      }
+
+      if (result$valid) {
+        data_rv$filter_valid <- TRUE
+        tags$span(style = "color: green;", "\u2713 Filter is valid")
+      } else {
+        data_rv$filter_valid <- FALSE
+
+        tags$span(style = "color: red;",
+                  "\u2717 ",
+                  line_break(result$message, lineLength = 30))
+      }
+    })
+
     shiny::observeEvent(input$data_import, {
       shiny::req(input$fields)
 
       # browser()
       record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
 
+      if (!is.null(data_rv$filter_valid)) {
+        if (isTRUE(data_rv$filter_valid)) {
+          filter <- trimws(input$filter)
+        } else {
+          filter <- ""
+        }
+      } else {
+        filter <- ""
+      }
 
       parameters <- list(
         uri = data_rv$uri,
@@ -8356,7 +8535,8 @@ m_redcap_readServer <- function(id) {
         fields = unique(c(record_id, input$fields)),
         events = input$arms,
         raw_or_label = "both",
-        filter_logic = input$filter,
+        filter_logic = filter,
+        # filter_logic = "",
         split_forms = ifelse(
           input$data_type == "long" && !is.null(input$data_type),
           "none",
@@ -8365,31 +8545,48 @@ m_redcap_readServer <- function(id) {
       )
 
       shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
-        imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
+        imported <- try({
+          rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters)
+          # if (nrow(out)==0){
+          #   stop("No data was exported")
+          # } else {
+          #   out
+          # }
+        }, # error = function(err) {
+        #   showNotification(i18n$t("An error was encountered exporting data. Please review data filter."), type = "error")
+        # },
+        silent = TRUE)
       })
 
-      parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
+      # d <- REDCapCAST::apply_factor_labels(data = imported$survey, meta = data_rv$dd_list$data)
 
-      code <- rlang::call2(
-        "easy_redcap",
-        !!!utils::modifyList(
-          parameters_code,
-          list(
-            data_format = ifelse(
-              input$data_type == "long" && !is.null(input$data_type),
-              "long",
-              "wide"
-            ),
-            project.name = simple_snake(data_rv$info$project_title)
-          )
-        ),
-        .ns = "REDCapCAST"
-      )
+      parameters_code <- parameters[c("uri",
+                                      "fields",
+                                      "events",
+                                      "raw_or_label",
+                                      "filter_logic")]
 
-      if (inherits(imported, "try-error") || NROW(imported) < 1) {
+      code <- rlang::call2("easy_redcap",
+                           !!!utils::modifyList(
+                             parameters_code,
+                             list(
+                               data_format = ifelse(
+                                 input$data_type == "long" && !is.null(input$data_type),
+                                 "long",
+                                 "wide"
+                               ),
+                               project.name = simple_snake(data_rv$info$project_title)
+                             )
+                           ),
+                           .ns = "REDCapCAST")
+
+      if (inherits(imported, "try-error") |
+          NROW(imported) == 0 |
+          (length(imported) == 1 & !is.list(imported))) {
         data_rv$data_status <- "error"
         data_rv$data_list <- NULL
-        data_rv$data_message <- imported$raw_text
+        data_rv$data_message <- i18n$t("An empty data set was imported. Please review data filter.")
+        data_rv$data <- NULL
       } else {
         data_rv$data_status <- "success"
         data_rv$data_message <- i18n$t("Requested data was retrieved!")
@@ -8398,12 +8595,11 @@ m_redcap_readServer <- function(id) {
         ## "wide"/"long" without re-importing data
 
         if (parameters$split_form == "all") {
-          # browser()
           out <- imported |>
             # redcap_wider()
             REDCapCAST::redcap_wider()
         } else {
-          if (input$fill == "yes") {
+          if (identical(input$fill, "yes")) {
             ## Repeated fields
 
 
@@ -8421,78 +8617,102 @@ m_redcap_readServer <- function(id) {
           }
         }
 
-        # browser()
+        ## Ensure correct factor labels
+        ## It is a little hacky and should be included in the read_redcap_tables, but is lost along the way
+        out <- REDCapCAST::apply_factor_labels(data = out, meta = data_rv$dd_list$data)
+
+
         in_data_check <- parameters$fields %in% names(out) |
-          sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
+          sapply(names(out), \(.x) any(sapply(
+            parameters$fields, \(.y) startsWith(.x, .y)
+          )))
 
         if (!any(in_data_check[-1])) {
           data_rv$data_status <- "warning"
-          data_rv$data_message <- i18n$t("Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
+          data_rv$data_message <- i18n$t(
+            "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+          )
         }
 
         if (!all(in_data_check)) {
           data_rv$data_status <- "warning"
-          data_rv$data_message <- i18n$t("Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
+          data_rv$data_message <- i18n$t(
+            "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+          )
         }
 
         data_rv$code <- code
 
+        ## Level labels nare lost at this point...
         data_rv$data <- out |>
           dplyr::select(-dplyr::ends_with("_complete")) |>
           # dplyr::select(-dplyr::any_of(record_id)) |>
           REDCapCAST::suffix2label()
+
       }
     })
 
-    shiny::observeEvent(
-      data_rv$data_status,
-      {
-        # browser()
-        if (identical(data_rv$data_status, "error")) {
-          datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
-        } else if (identical(data_rv$data_status, "success")) {
-          datamods:::insert_alert(
-            selector = ns("retrieved"),
-            status = data_rv$data_status,
-            # tags$p(
-            #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
-            #   data_rv$data_message
-            # ),
-            include_data_alert(
-              see_data_text = i18n$t("Click to see the imported data"),
-              dataIdName = "see_data",
-              extra = tags$p(
-                tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
-              ),
-              btn_show_data = TRUE
-            )
+    shiny::observeEvent(data_rv$data_status, {
+      if (identical(data_rv$data_status, "error")) {
+        ## The insert error wouldn't work. Inserted through regular.
+        # datamods:::insert_error(mssg = data_rv$data_message,
+        #                         selector = ns("retrieved"))
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = "danger",
+          tags$p(
+            tags$b(
+              phosphoricons::ph("warning", weight = "bold"),
+              "Warning!"
+            ),
+            data_rv$data_message
           )
-        } else {
-          datamods:::insert_alert(
-            selector = ns("retrieved"),
-            status = data_rv$data_status,
-            tags$p(
-              tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
+        )
+      } else if (identical(data_rv$data_status, "success")) {
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = data_rv$data_status,
+          # tags$p(
+          #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+          #   data_rv$data_message
+          # ),
+          include_data_alert(
+            see_data_text = i18n$t("Click to see the imported data"),
+            dataIdName = "see_data",
+            extra = tags$p(tags$b(
+              phosphoricons::ph("check", weight = "bold"),
               data_rv$data_message
-            )
+            )),
+            btn_show_data = TRUE
           )
-        }
+        )
+      } else {
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = data_rv$data_status,
+          tags$p(
+            tags$b(
+              phosphoricons::ph("warning", weight = "bold"),
+              "Warning!"
+            ),
+            data_rv$data_message
+          )
+        )
       }
-    )
+    })
 
-    return(list(
-      status = shiny::reactive(data_rv$data_status),
-      name = shiny::reactive(data_rv$info$project_title),
-      info = shiny::reactive(data_rv$info),
-      code = shiny::reactive(data_rv$code),
-      data = shiny::reactive(data_rv$data)
-    ))
+    return(
+      list(
+        status = shiny::reactive(data_rv$data_status),
+        name = shiny::reactive(data_rv$info$project_title),
+        info = shiny::reactive(data_rv$info),
+        code = shiny::reactive(data_rv$code),
+        data = shiny::reactive(data_rv$data)
+      )
+    )
   }
 
-  shiny::moduleServer(
-    id = id,
-    module = module
-  )
+  shiny::moduleServer(id = id, module = module)
 }
 
 #' @importFrom htmltools tagList tags
@@ -8503,14 +8723,12 @@ include_data_alert <- function(dataIdName = "see_data",
                                extra = NULL,
                                session = shiny::getDefaultReactiveDomain()) {
   if (isTRUE(btn_show_data)) {
-    success_message <- tagList(
-      extra,
-      tags$br(),
-      shiny::actionLink(
-        inputId = session$ns(dataIdName),
-        label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
-      )
-    )
+    success_message <- tagList(extra,
+                               tags$br(),
+                               shiny::actionLink(
+                                 inputId = session$ns(dataIdName),
+                                 label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
+                               ))
   }
   return(success_message)
 }
@@ -8562,20 +8780,18 @@ is_valid_redcap_url <- function(url) {
 #' @examples
 #' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
 #' is_valid_token(token)
-is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
+is_valid_token <- function(token,
+                           pattern_env = NULL,
+                           nchar = 32) {
   checkmate::assert_character(token, any.missing = TRUE, len = 1)
 
   if (!is.null(pattern_env)) {
-    checkmate::assert_character(pattern_env,
-      any.missing = FALSE,
-      len = 1
-    )
+    checkmate::assert_character(pattern_env, any.missing = FALSE, len = 1)
     pattern <- pattern_env
   } else {
     pattern <- glue::glue("^([0-9A-Fa-f]{<nchar>})(?:\\n)?$",
-      .open = "<",
-      .close = ">"
-    )
+                          .open = "<",
+                          .close = ">")
   }
 
   if (is.na(token)) {
@@ -8615,10 +8831,15 @@ repeated_instruments <- function(uri, token) {
 #' @export
 #'
 drop_empty_event <- function(data, event = "redcap_event_name") {
-  generics <- c(names(data)[1], "redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
+  generics <- c(
+    names(data)[1],
+    "redcap_event_name",
+    "redcap_repeat_instrument",
+    "redcap_repeat_instance"
+  )
 
   filt <- split(data, data[[event]]) |>
-    lapply(\(.x){
+    lapply(\(.x) {
       dplyr::select(.x, -tidyselect::all_of(generics)) |>
         REDCapCAST::all_na()
     }) |>
@@ -8628,6 +8849,327 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
 }
 
 
+#' Validate a REDCap server-side filter string against a data dictionary
+#'
+#' Checks that a REDCap filter expression is syntactically correct and
+#' consistent with the field types defined in the project data dictionary.
+#' Plain text without field references is always rejected. Multi-clause
+#' filters joined by \code{AND} or \code{OR} are supported.
+#'
+#' @param filter A single character string containing the filter expression,
+#'   e.g. \code{"[age] > 18"} or \code{"[cohabitation] = '1' AND [age] > 18"}.
+#' @param dictionary A data frame representing the REDCap data dictionary in
+#'   API export format, as returned by e.g. \code{REDCapCAST::get_redcap_metadata()}.
+#'   Must contain at least the columns \code{field_name} and \code{field_type}.
+#'   The columns \code{text_validation_type_or_show_slider_number} and
+#'   \code{select_choices_or_calculations} are used when present for stricter
+#'   type and choice validation.
+#'
+#' @return A named list with two elements:
+#'   \describe{
+#'     \item{\code{valid}}{Logical. \code{TRUE} if the filter passes all checks.}
+#'     \item{\code{message}}{Character. \code{"Filter is valid."} on success, or
+#'       a newline-separated string of error messages describing every problem
+#'       found.}
+#'   }
+#'
+#' @details
+#' Validation rules by field type:
+#' \describe{
+#'   \item{\code{calc}}{Numeric fields. Value must be an unquoted number.
+#'     All comparison operators (\code{=}, \code{!=}, \code{<}, \code{>},
+#'     \code{<=}, \code{>=}) are accepted.}
+#'   \item{\code{text} with date validation}{Fields with validation type
+#'     \code{date_ymd}, \code{date_dmy}, \code{datetime_*}, etc. Value must be
+#'     a quoted date/datetime string in \code{'YYYY-MM-DD'} format. All
+#'     comparison operators are accepted.}
+#'   \item{\code{text} with time validation}{Fields with validation type
+#'     \code{time_hh_mm_ss} or \code{time_mm_ss}. Value must be a quoted time
+#'     string, e.g. \code{'14:30:00'}. All comparison operators are accepted.}
+#'   \item{\code{radio} / \code{dropdown}}{Categorical fields. Value must be a
+#'     quoted choice code (e.g. \code{'1'}) that exists in the field's choice
+#'     list. Only \code{=} and \code{!=} are accepted.}
+#'   \item{\code{text} (plain)}{Free-text fields. Value must be a quoted string.
+#'     Only \code{=} and \code{!=} are accepted.}
+#' }
+#'
+#' @examples
+#' \dontrun{
+#' dict <- REDCapCAST::get_redcap_metadata(
+#'   uri    = "https://redcap.example.com/api/",
+#'   token  = Sys.getenv("REDCAP_TOKEN")
+#' )
+#'
+#' validate_redcap_filter("[age] > 18", dict)
+#' #> list(valid = TRUE, message = "Filter is valid.")
+#'
+#' validate_redcap_filter("only plain text", dict)
+#' #> list(valid = FALSE, message = "Filter must contain at least one field ...")
+#'
+#' validate_redcap_filter("[cohabitation] = '1' AND [age] > 18", dict)
+#' #> list(valid = TRUE, message = "Filter is valid.")
+#' }
+#'
+#' @export
+# REDCap filter validation based on data dictionary
+#
+# REDCap filter format: [field_name] operator value
+# Example: [age] > 18
+#          [cohabitation] = '1'
+#          [inclusion] > '2020-01-01'
+#
+# Supported field types and their allowed operators/value formats:
+#   text (no validation) -> string values, = != operators only
+#   text (date_ymd/date_dmy) -> quoted date strings, all comparison operators
+#   text (time_hh_mm_ss) -> quoted time strings, all comparison operators
+#   text (datetime_*) -> quoted datetime strings, all comparison operators
+#   text (autocomplete) -> string values, = != operators only
+#   calc -> numeric values, all comparison operators
+#   radio/dropdown -> quoted numeric codes, = != operators only
+
+validate_redcap_filter <- function(filter, dictionary) {
+  # --- Input checks ---
+  if (!is.character(filter) ||
+      length(filter) != 1 || nchar(trimws(filter)) == 0) {
+    return(list(valid = FALSE, message = "Filter must be a non-empty string."))
+  }
+
+  if (!grepl("\\[.+\\]", filter)) {
+    return(
+      list(valid = FALSE, message = "Filter must contain at least one field reference in [brackets]. Plain text is not accepted.")
+    )
+  }
+
+  # --- Column names (API export format) ---
+  col_field    <- "field_name"
+  col_type     <- "field_type"
+  col_val_type <- "text_validation_type_or_show_slider_number"
+  col_choices  <- "select_choices_or_calculations"
+
+  missing_cols <- setdiff(c(col_field, col_type), names(dictionary))
+  if (length(missing_cols) > 0) {
+    stop("Dictionary is missing required columns: ",
+         paste(missing_cols, collapse = ", "))
+  }
+
+  # --- Build lookup index once for O(1) field access ---
+  field_idx    <- setNames(seq_len(nrow(dictionary)), dictionary[[col_field]])
+  has_val_type <- col_val_type %in% names(dictionary)
+  has_choices  <- col_choices  %in% names(dictionary)
+
+  # --- Classify field types ---
+  numeric_types    <- c("calc")
+  date_validations <- c(
+    "date_ymd",
+    "date_dmy",
+    "datetime_ymd",
+    "datetime_dmy",
+    "datetime_seconds_ymd",
+    "datetime_seconds_dmy"
+  )
+  time_validations <- c("time_hh_mm_ss", "time_mm_ss")
+  categorical_types <- c("radio", "dropdown", "checkbox")
+  text_types        <- c("text", "autocomplete")
+
+  num_ops  <- c("=", "!=", "<", ">", "<=", ">=")
+  cat_ops  <- c("=", "!=")
+  text_ops <- c("=", "!=")
+
+  # --- Parse filter into clauses ---
+  # Split on AND/OR (REDCap uses 'and'/'or' or 'AND'/'OR')
+  clauses <- trimws(strsplit(filter, "(?i)\\s+(and|or)\\s+", perl = TRUE)[[1]])
+
+  clause_pattern <- "^\\[([^\\]]+)\\]\\s*(=|!=|<=|>=|<|>)\\s*(.+)$"
+
+  errors <- character(0)
+
+  for (clause in clauses) {
+    if (!grepl(clause_pattern, clause, perl = TRUE)) {
+      errors <- c(
+        errors,
+        sprintf(
+          "Clause '%s' does not match expected format: [field] operator value",
+          clause
+        )
+      )
+      next
+    }
+
+    parts    <- regmatches(clause, regexec(clause_pattern, clause, perl = TRUE))[[1]]
+    field    <- parts[2]
+    operator <- parts[3]
+    value    <- trimws(parts[4])
+
+    # --- Check field exists using pre-built index ---
+    row_i <- field_idx[field]
+    if (is.na(row_i)) {
+      errors <- c(errors, sprintf("Unknown field: [%s]", field))
+      next
+    }
+
+    field_type <- dictionary[[col_type]][row_i]
+    val_type   <- if (has_val_type)
+      dictionary[[col_val_type]][row_i]
+    else
+      ""
+    if (is.na(val_type))
+      val_type <- ""
+
+    # --- Determine expected value format and allowed operators ---
+    if (field_type %in% numeric_types ||
+        grepl("^integer$|^number", val_type)) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is numeric — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^-?[0-9]+(\\.[0-9]+)?$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is numeric — value '%s' should be an unquoted number (e.g. 18 or 3.5)",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (val_type %in% date_validations) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a date — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl(
+        "^'[0-9]{4}-[0-9]{2}-[0-9]{2}(\\s[0-9]{2}:[0-9]{2}(:[0-9]{2})?)?'$",
+        value
+      )) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a date — value '%s' should be a quoted date string, e.g. '2020-01-31'",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (val_type %in% time_validations) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a time — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^'[0-9]{2}:[0-9]{2}(:[0-9]{2})?'$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a time — value '%s' should be a quoted time string, e.g. '14:30:00'",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (field_type %in% categorical_types) {
+      if (!operator %in% cat_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is categorical — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(cat_ops, collapse = ", ")
+          )
+        )
+      }
+
+      # Validate value is a known choice code
+      choices_raw <- if (has_choices)
+        dictionary[[col_choices]][row_i]
+      else
+        NA
+      if (!is.na(choices_raw) && nchar(trimws(choices_raw)) > 0) {
+        choice_codes <- trimws(gsub(",.+?(\\||$)", "", gsub(
+          "^\\s*", "", strsplit(choices_raw, "\\|")[[1]]
+        )))
+        value_unquoted <- gsub("^'|'$", "", value)
+        if (!value_unquoted %in% choice_codes) {
+          errors <- c(
+            errors,
+            sprintf(
+              "[%s] is categorical — '%s' is not a valid choice code. Valid codes: %s",
+              field,
+              value_unquoted,
+              paste(choice_codes, collapse = ", ")
+            )
+          )
+        }
+      }
+
+      if (!grepl("^'.*'$", value)) {
+        errors <- c(errors,
+                    sprintf(
+                      "[%s] is categorical — value should be quoted, e.g. '1'",
+                      field
+                    ))
+      }
+
+    } else {
+      # Plain text field
+      if (!operator %in% text_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a text field — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(text_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^'.*'$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a text field — value should be quoted, e.g. 'some text'",
+            field
+          )
+        )
+      }
+    }
+  }
+
+  if (length(errors) > 0) {
+    return(list(
+      valid = FALSE,
+      message = paste(errors, collapse = "\n")
+    ))
+  }
+
+  list(valid = TRUE, message = "Filter is valid.")
+}
+
+
+
 #' Test app for the redcap_read_shiny_module
 #'
 #' @rdname redcap_read_shiny_module
@@ -8646,16 +9188,10 @@ redcap_demo_app <- function() {
   server <- function(input, output, session) {
     data_val <- m_redcap_readServer(id = "data")
 
-    output$data <- DT::renderDataTable(
-      {
-        shiny::req(data_val$data)
-        data_val$data()
-      },
-      options = list(
-        scrollX = TRUE,
-        pageLength = 5
-      ),
-    )
+    output$data <- DT::renderDataTable({
+      shiny::req(data_val$data)
+      data_val$data()
+    }, options = list(scrollX = TRUE, pageLength = 5), )
     output$code <- shiny::renderPrint({
       shiny::req(data_val$code)
       data_val$code()
@@ -10054,7 +10590,7 @@ regression_server <- function(id,
               rv$list$regression$models <- model_lists
             },
             error = function(err) {
-              showNotification(paste(i18n$t("Creating regression models failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Creating regression models failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -10119,7 +10655,7 @@ regression_server <- function(id,
               showNotification(paste0(warn), type = "warning")
             },
             error = function(err) {
-              showNotification(paste(i18n$t("Creating a regression table failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Creating a regression table failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -10197,7 +10733,7 @@ regression_server <- function(id,
               gg_theme_shiny()
           },
           error = function(err) {
-            showNotification(paste0(err), type = "err")
+            showNotification(paste0(err), type = "error")
           }
         )
       })
@@ -10257,7 +10793,7 @@ regression_server <- function(id,
             #   showNotification(paste0(warn), type = "warning")
             # },
             error = function(err) {
-              showNotification(paste(i18n$t("Running model assumptions checks failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Running model assumptions checks failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -10328,7 +10864,7 @@ regression_server <- function(id,
                 out <- patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
               },
               error = function(err) {
-                showNotification(err, type = "err")
+                showNotification(err, type = "error")
               }
             )
 
@@ -11998,15 +12534,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",
@@ -12039,7 +12586,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,
@@ -12094,6 +12643,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
@@ -12177,7 +12740,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)))
         })
@@ -12187,7 +12750,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
           "We encountered the following error creating the new factor:",
           err
         ),
-        type = "err")
+        type = "error")
       })
 
       # browser()
@@ -12341,6 +12904,15 @@ unique_names <- function(new, existing = character()) {
 }
 
 
+has_empty_levels <- function(x) {
+  if (is.factor(x)) {
+    any(!levels(x) %in% x)
+  } else {
+    return(FALSE)
+  }
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R 
 ########
@@ -14871,7 +15443,7 @@ server <- function(input, output, session) {
       showNotification(paste(
         i18n$t("We encountered the following error showing missingness:"),
         err
-      ), type = "err")
+      ), type = "error")
     })
   })
 
@@ -15128,6 +15700,7 @@ server <- function(input, output, session) {
       inputId = "column_filter",
       label = i18n$t("Select data types to include"),
       selected = unique(data_type(rv$data)),
+      #[unique(data_type(rv$data))!="text"],
       choices = unique(data_type(rv$data)),
       updateOn = "change",
       multiple = TRUE,
@@ -15220,48 +15793,58 @@ server <- function(input, output, session) {
   #########  Data filter
   # IDEAFilter has the least cluttered UI, but might have a License issue
   # Consider using shinyDataFilter, though not on CRAN
-  data_filter <- IDEAFilter::IDEAFilter(
+  data_filter_raw <- IDEAFilter::IDEAFilter(
     "data_filter",
-    data = shiny::reactive(rv$data_variables),
+    data = shiny::reactive(non_character_cols(rv$data_variables)),
     verbose = TRUE
   )
 
-  shiny::observeEvent(list(
-    shiny::reactive(rv$data_variables),
-    shiny::reactive(rv$data_original),
-    data_filter(),
-    # regression_vars(),
-    input$complete_cutoff
-  ),
-  {
-    ###  Save filtered data
-    rv$data_filtered <- data_filter()
-
-    ###  Save filtered data
-    ###  without empty factor levels
-    rv$list$data <- data_filter() |>
-      REDCapCAST::fct_drop() |>
-      (\(.x) {
-        .x[!sapply(.x, is.character)]
-      })()
-
-    ## This looks messy!! But it works as intended for now
-
-    out <- gsub("filter", "dplyr::filter", gsub("\\s{2,}", " ", paste0(capture.output(
-      attr(rv$data_filtered, "code")
-    ), collapse = " ")))
-
-    out <- strsplit(out, "%>%") |>
-      unlist() |>
-      (\(.x) {
-        paste(c("df <- df", .x[-1], "REDCapCAST::fct_drop()"), collapse = "|> \n ")
-      })()
-
-    rv$code <- append_list(data = out,
-                           list = rv$code,
-                           index = "filter")
+  data_filter <- reactive({
+    apply_idea_filter(data_filter_raw, rv$data_variables)
   })
 
+  shiny::observeEvent(
+    list(
+      shiny::reactive(rv$data_variables),
+      shiny::reactive(rv$data_original),
+      data_filter_raw(),
+      # regression_vars(),
+      input$complete_cutoff
+    ),
+    {
+      ###  Save filtered data
+      # browser()
+      # rv$data_filtered <- apply_idea_filter(data_filter_raw, rv$data_variables)()
+      rv$data_filtered <- data_filter()
+
+      ###  Save filtered data
+      ###  ~~without empty factor levels~~
+      ###  All factor levels are kept, but can be manually removed
+      # browser()
+      rv$list$data <- rv$data_filtered #|>
+      # # REDCapCAST::fct_drop() |>
+      # (\(.x) {
+      #   .x[!sapply(.x, is.character)]
+      # })()
+
+      ## This looks messy!! But it works as intended for now
+      # browser()
+      out <- gsub("filter", "dplyr::filter", gsub("\\s{2,}", " ", paste0(capture.output(
+        attr(data_filter_raw(), "code")
+      ), collapse = " ")))
+
+      out <- strsplit(out, "%>%") |>
+        unlist() |>
+        (\(.x) {
+          paste(c("df <- df", .x[-1]), collapse = "|> \n ")
+        })()
+
+      rv$code <- append_list(data = out,
+                             list = rv$code,
+                             index = "filter")
+    }
+  )
+
   #########  Data preview
 
   ###  Overview
@@ -15279,7 +15862,7 @@ server <- function(input, output, session) {
   observeEvent(input$modal_browse, {
     tryCatch({
       show_data(
-        REDCapCAST::fct_drop(rv$data_filtered),
+        rv$data_filtered,
         title = i18n$t("Uploaded data overview"),
         type = "modal"
       )
@@ -15287,7 +15870,7 @@ server <- function(input, output, session) {
       showNotification(paste(
         i18n$t("We encountered the following error browsing your data:"),
         err
-      ), type = "err")
+      ), type = "error")
     })
   })
 
@@ -15313,7 +15896,7 @@ server <- function(input, output, session) {
       showNotification(paste(
         i18n$t("We encountered the following error showing missingness:"),
         err
-      ), type = "err")
+      ), type = "error")
     })
   })
 
@@ -15520,7 +16103,7 @@ server <- function(input, output, session) {
     #     }
     #   },
     #   error = function(err) {
-    #     showNotification(err, type = "err")
+    #     showNotification(err, type = "error")
     #   }
     # )
 
@@ -15679,7 +16262,7 @@ server <- function(input, output, session) {
               "We encountered the following error creating your report: "
             ),
             err
-          ), type = "err")
+          ), type = "error")
         })
       })
       file.rename(paste0("www/report.", type), file)
diff --git a/app_docker/renv.lock b/app_docker/renv.lock
index 567601cc..96709a25 100644
--- a/app_docker/renv.lock
+++ b/app_docker/renv.lock
@@ -35,12 +35,12 @@
     },
     "DHARMa": {
       "Package": "DHARMa",
-      "Version": "0.4.6",
+      "Version": "0.4.7",
       "Source": "Repository",
       "Title": "Residual Diagnostics for Hierarchical (Multi-Level / Mixed) Regression Models",
-      "Date": "2022-09-08",
-      "Authors@R": "c(person(\"Florian\", \"Hartig\", email = \"florian.hartig@biologie.uni-regensburg.de\", role = c(\"aut\", \"cre\"), comment=c(ORCID=\"0000-0002-6255-9059\")), person(\"Lukas\", \"Lohse\", role = \"ctb\"))",
-      "Description": "The 'DHARMa' package uses a simulation-based approach to create readily interpretable scaled (quantile) residuals for fitted (generalized) linear mixed models. Currently supported are linear and generalized linear (mixed) models from 'lme4' (classes 'lmerMod', 'glmerMod'), 'glmmTMB' 'GLMMadaptive' and 'spaMM', generalized additive models ('gam' from 'mgcv'), 'glm' (including 'negbin' from 'MASS', but excluding quasi-distributions) and 'lm' model classes. Moreover, externally created simulations, e.g. posterior predictive simulations from Bayesian software such as 'JAGS', 'STAN', or 'BUGS' can be processed as well. The resulting residuals are standardized to values between 0 and 1 and can be interpreted as intuitively as residuals from a linear regression. The package also provides a number of plot and test functions for typical model misspecification problems, such as over/underdispersion, zero-inflation, and residual spatial and temporal autocorrelation.",
+      "Date": "2024-10-16",
+      "Authors@R": "c(person(\"Florian\", \"Hartig\", email = \"florian.hartig@biologie.uni-regensburg.de\", role = c(\"aut\", \"cre\"), comment=c(ORCID=\"0000-0002-6255-9059\")), person(\"Lukas\", \"Lohse\", role = \"ctb\"), person(\"Melina\", \"de Souza leite\", role = \"ctb\"))",
+      "Description": "The 'DHARMa' package uses a simulation-based approach to create readily interpretable scaled (quantile) residuals for fitted (generalized) linear mixed models. Currently supported are linear and generalized linear (mixed) models from 'lme4' (classes 'lmerMod', 'glmerMod'), 'glmmTMB', 'GLMMadaptive', and 'spaMM'; phylogenetic  linear models from 'phylolm' (classes 'phylolm' and 'phyloglm'); generalized additive  models ('gam' from 'mgcv'); 'glm' (including 'negbin' from 'MASS', but excluding quasi-distributions) and 'lm' model classes. Moreover, externally created simulations, e.g. posterior predictive simulations from Bayesian software such as 'JAGS', 'STAN', or 'BUGS' can be processed as well. The resulting residuals are standardized to values between 0 and 1 and can be interpreted as intuitively as residuals from a linear regression. The package also provides a number of plot and test functions for typical model misspecification problems, such as over/underdispersion, zero-inflation, and residual spatial, phylogenetic and temporal autocorrelation.",
       "Depends": [
         "R (>= 3.0.2)"
       ],
@@ -59,7 +59,7 @@
       ],
       "Suggests": [
         "knitr",
-        "testthat",
+        "testthat (>= 3.0.0)",
         "rmarkdown",
         "KernSmooth",
         "sfsmisc",
@@ -68,7 +68,8 @@
         "mgcViz (>= 0.1.9)",
         "spaMM (>= 3.2.0)",
         "GLMMadaptive",
-        "glmmTMB (>= 1.1.2.3)"
+        "glmmTMB (>= 1.1.2.3)",
+        "phylolm (>= 2.6.5)"
       ],
       "Enhances": [
         "phyr",
@@ -80,11 +81,12 @@
       "URL": "http://florianhartig.github.io/DHARMa/",
       "LazyData": "TRUE",
       "BugReports": "https://github.com/florianhartig/DHARMa/issues",
-      "RoxygenNote": "7.2.1",
+      "RoxygenNote": "7.3.2",
       "VignetteBuilder": "knitr",
       "Encoding": "UTF-8",
+      "Config/testthat/edition": "3",
       "NeedsCompilation": "no",
-      "Author": "Florian Hartig [aut, cre] (<https://orcid.org/0000-0002-6255-9059>), Lukas Lohse [ctb]",
+      "Author": "Florian Hartig [aut, cre] (<https://orcid.org/0000-0002-6255-9059>), Lukas Lohse [ctb], Melina de Souza leite [ctb]",
       "Maintainer": "Florian Hartig <florian.hartig@biologie.uni-regensburg.de>",
       "Repository": "CRAN"
     },
@@ -2345,7 +2347,7 @@
     },
     "datamods": {
       "Package": "datamods",
-      "Version": "1.5.2",
+      "Version": "1.5.3",
       "Source": "Repository",
       "Title": "Modules to Import and Manipulate Data in 'Shiny'",
       "Authors@R": "c(person(given = \"Victor\", family = \"Perrier\", role = c(\"aut\", \"cre\", \"cph\"), email = \"victor.perrier@dreamrs.fr\"), person(given = \"Fanny\", family = \"Meyer\", role = \"aut\"), person(given = \"Samra\", family = \"Goumri\", role = \"aut\"), person(given = \"Zauad Shahreer\", family = \"Abeer\", role = \"aut\", email = \"shahreyar.abeer@gmail.com\"), person(given = \"Eduard\", family = \"Szöcs\", role = \"ctb\", email = \"eduardszoecs@gmail.com\") )",
@@ -8357,7 +8359,7 @@
     },
     "shinybusy": {
       "Package": "shinybusy",
-      "Version": "0.3.2",
+      "Version": "0.3.3",
       "Source": "Repository",
       "Title": "Busy Indicators and Notifications for 'Shiny' Applications",
       "Authors@R": "c(person(\"Fanny\", \"Meyer\", role = \"aut\"), person(\"Victor\", \"Perrier\", email = \"victor.perrier@dreamrs.fr\", role = c(\"aut\", \"cre\")), person(\"Silex Technologies\", comment = \"https://www.silex-ip.com\", role = \"fnd\"))",
@@ -8370,8 +8372,8 @@
         "jsonlite",
         "htmlwidgets"
       ],
-      "RoxygenNote": "7.2.3",
-      "URL": "https://github.com/dreamRs/shinybusy",
+      "RoxygenNote": "7.3.1",
+      "URL": "https://github.com/dreamRs/shinybusy, https://dreamrs.github.io/shinybusy/",
       "BugReports": "https://github.com/dreamRs/shinybusy/issues",
       "Suggests": [
         "testthat",
diff --git a/app_docker/translations/translation_da.csv b/app_docker/translations/translation_da.csv
index ce9abc8e..4f3752bd 100644
--- a/app_docker/translations/translation_da.csv
+++ b/app_docker/translations/translation_da.csv
@@ -55,7 +55,6 @@
 "Imported data","Importeret data"
 "www/intro.md","www/intro.md"
 "Choose your data","Vælg dine data"
-"Factor variable to reorder:","Kategoriske variabel der skal ændres:"
 "Sort by levels","Sorter efter niveauer"
 "Sort by count","Sorter efter antal"
 "Update factor variable","Updater faktor-variabel"
@@ -148,16 +147,12 @@
 "Import data from REDCap","Importér data fra REDCap"
 "REDCap server","REDCap-server"
 "Web address","Serveradresse"
-"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Adressen skal være som 'https://redcap.your.institution/' eller 'https://your.institution/redcap/'"
 "API token","API-nøgle"
-"The token is a string of 32 numbers and letters.","En API-nøgle består af ialt 32 tal og bogstaver."
 "Connect","Forbind"
 "Data import parameters","Data import parameters"
-"Select fields/variables to import and click the funnel to apply optional filters","Vælg variabler, der skal importeres og tryk på tragten for at anvende valgfrie filtre"
 "Import","Import"
 "Click to see data dictionary","Tryk for at se metadata (Data Dictionary)"
 "Connected to server!","Forbindelse til serveren oprettet!"
-"The {data_rv$info$project_title} project is loaded.","{data_rv$info$project_title}-projektet er forbundet."
 "Data dictionary","Data dictionary"
 "Preview:","Forsmag:"
 "Imported data set","Importeret datasæt"
@@ -165,8 +160,6 @@
 "Specify the data format","Specificér dataformatet"
 "Fill missing values?","Skal manglende observationer udfyldes?"
 "Requested data was retrieved!","Det udvalgte data blev hentet!"
-"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data er hentet, men det ser ud til kun at indeholde ID-variablen. Du skal kontakte din REDCap-administrator og sikre dig at du har adgang til faktisk at hente de udvalgte data."
-"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data er hentet, men det ser ud til kun at indeholde nogle af de udvalgte variabler. Du skal kontakte din REDCap-administrator og sikre dig at du har adgang til faktisk at hente de udvalgte data."
 "Click to see the imported data","Tryk for at se de importerede data"
 "Regression table","Regressionstabel"
 "Import a dataset from an environment","Importer et datasæt fra et kodemiljø"
@@ -291,7 +284,6 @@
 "No data present.","Ingen data tilstede."
 "You have provided a complete dataset with no missing values.","Data er uden manglende observationer."
 "Start by loading data.","Start med at vælge data."
-"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)"
 "Data classes and missing observations","Data classes and missing observations"
 "We encountered the following error showing missingness:","We encountered the following error showing missingness:"
 "Please confirm data reset!","Please confirm data reset!"
@@ -323,3 +315,9 @@
 "Settings","Settings"
 "Create new factor","Create new factor"
 "Choose color palette","Choose color palette"
+"Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
+"Drop empty","Drop empty"
+"Choose variable:","Choose variable:"
+"An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
+"An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
+"Likert diagram","Likert diagram"
diff --git a/app_docker/translations/translation_sw.csv b/app_docker/translations/translation_sw.csv
index 96a7a109..a375e0a5 100644
--- a/app_docker/translations/translation_sw.csv
+++ b/app_docker/translations/translation_sw.csv
@@ -55,7 +55,6 @@
 "Imported data","Data iliyoingizwa"
 "www/intro.md","www/intro.md"
 "Choose your data","Chagua data yako"
-"Factor variable to reorder:","Kigezo cha vipengele ili kupanga upya:"
 "Sort by levels","Panga kwa viwango"
 "Sort by count","Panga kwa hesabu"
 "Update factor variable","Sasisha kigezo cha kipengele"
@@ -148,16 +147,12 @@
 "Import data from REDCap","Ingiza data kutoka REDCap"
 "REDCap server","Seva ya REDCap"
 "Web address","Anwani ya wavuti"
-"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Muundo unapaswa kuwa 'https://redcap.your.institution/' au 'https://your.institution/redcap/'"
 "API token","Tokeni ya API"
-"The token is a string of 32 numbers and letters.","Tokeni ni mfuatano wa nambari na herufi 32."
 "Connect","Unganisha"
 "Data import parameters","Vigezo vya kuingiza data"
-"Select fields/variables to import and click the funnel to apply optional filters","Chagua sehemu/vigezo vya kuingiza na ubofye faneli ili kutumia vichujio vya hiari"
 "Import","Ingiza"
 "Click to see data dictionary","Bofya ili kuona kamusi ya data"
 "Connected to server!","Imeunganishwa na seva!"
-"The {data_rv$info$project_title} project is loaded.","Mradi wa {data_rv$info$project_title} umepakiwa."
 "Data dictionary","Kamusi ya data"
 "Preview:","Hakikisho:"
 "Imported data set","Seti ya data iliyoingizwa"
@@ -165,8 +160,6 @@
 "Specify the data format","Bainisha umbizo la data"
 "Fill missing values?","Jaza thamani zinazokosekana?"
 "Requested data was retrieved!","Data iliyoombwa ilipatikana!"
-"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data imerejeshwa, lakini inaonekana ni kitambulisho pekee kilichorejeshwa kutoka kwa seva. Tafadhali wasiliana na msimamizi wako wa REDCap kama una ruhusa zinazohitajika kwa ufikiaji wa data."
-"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data imerejeshwa, lakini inaonekana kama si sehemu zote zilizoombwa zilizorejeshwa kutoka kwa seva. Tafadhali wasiliana na msimamizi wako wa REDCap kama una ruhusa zinazohitajika kwa ufikiaji wa data."
 "Click to see the imported data","Bofya ili kuona data iliyoingizwa"
 "Regression table","Jedwali la urejeshaji"
 "Import a dataset from an environment","Ingiza seti ya data kutoka kwa mazingira"
@@ -291,7 +284,6 @@
 "No data present.","No data present."
 "You have provided a complete dataset with no missing values.","You have provided a complete dataset with no missing values."
 "Start by loading data.","Start by loading data."
-"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)"
 "Data classes and missing observations","Data classes and missing observations"
 "We encountered the following error showing missingness:","We encountered the following error showing missingness:"
 "Please confirm data reset!","Please confirm data reset!"
@@ -323,3 +315,9 @@
 "Settings","Settings"
 "Create new factor","Create new factor"
 "Choose color palette","Choose color palette"
+"Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
+"Drop empty","Drop empty"
+"Choose variable:","Choose variable:"
+"An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
+"An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
+"Likert diagram","Likert diagram"
diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R
index 1b6bf0c1..860dcd05 100644
--- a/inst/apps/FreesearchR/app.R
+++ b/inst/apps/FreesearchR/app.R
@@ -1,7 +1,7 @@
 
 
 ########
-#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpoawSeD/fileab3b7554cf72.R 
+#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpgCu9u6/file55d839c4d43b.R 
 ########
 
 i18n_path <- system.file("translations", package = "FreesearchR")
@@ -64,7 +64,7 @@ i18n$set_translation_language("en")
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'26.3.4'
+app_version <- function()'26.3.5'
 
 
 ########
@@ -84,7 +84,10 @@ app_version <- function()'26.3.4'
 #' @examples
 #' mtcars |> baseline_table()
 #' mtcars |> baseline_table(fun.args = list(by = "gear"))
-baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) {
+baseline_table <- function(data,
+                           fun.args = NULL,
+                           fun = gtsummary::tbl_summary,
+                           vars = NULL) {
   out <- do.call(fun, c(list(data = data), fun.args))
   return(out)
 }
@@ -110,7 +113,15 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
 #' mtcars |> create_baseline(by.var = "gear", detail_level = "extended",type = list(gtsummary::all_dichotomous() ~ "categorical"),theme="nejm")
 #'
 #' create_baseline(default_parsing(mtcars), by.var = "am", add.p = FALSE, add.overall = FALSE, theme = "lancet")
-create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, add.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon"), detail_level = c("minimal", "extended")) {
+create_baseline <- function(data,
+                            ...,
+                            by.var,
+                            add.p = FALSE,
+                            add.diff = FALSE,
+                            add.overall = FALSE,
+                            theme = c("jama", "lancet", "nejm", "qjecon"),
+                            detail_level = c("minimal", "extended"),
+                            drop_empty = FALSE) {
   theme <- match.arg(theme)
 
   detail_level <- match.arg(detail_level)
@@ -137,31 +148,28 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, ad
   if (!any(hasName(args, c("type", "statistic")))) {
     if (detail_level == "extended") {
       args <-
-        modifyList(
-          args,
-          list(
-            type = list(gtsummary::all_continuous() ~ "continuous2",
-                        gtsummary::all_dichotomous() ~ "categorical"),
-            statistic = list(gtsummary::all_continuous() ~ c(
-              "{median} ({p25}, {p75})",
-              "{mean} ({sd})",
-              "{min}, {max}"))
+        modifyList(args, list(
+          type = list(
+            gtsummary::all_continuous() ~ "continuous2",
+            gtsummary::all_dichotomous() ~ "categorical"
+          ),
+          statistic = list(
+            gtsummary::all_continuous() ~ c("{median} ({p25}, {p75})", "{mean} ({sd})", "{min}, {max}")
           )
-        )
+        ))
     }
   }
 
-  parameters <- list(
-    data = data,
-    fun.args = purrr::list_flatten(list(by = by.var, args))
-  )
+  if (isTRUE(drop_empty)) {
+    ## Drops empty levels if minimal
+    data <- data |> REDCapCAST::fct_drop()
+  }
+
+  parameters <- list(data = data, fun.args = purrr::list_flatten(list(by = by.var, args)))
 
 
   # browser()
-  out <- do.call(
-    baseline_table,
-    parameters
-  )
+  out <- do.call(baseline_table, parameters)
 
 
   if (!is.null(by.var)) {
@@ -1121,7 +1129,7 @@ vectorSelectInput <- function(inputId,
 colorSelectInput <- function(inputId,
                              label,
                              choices,
-                             selected = "",
+                             selected = NULL,
                              previews = 4,
                              ...,
                              placeholder = "") {
@@ -1157,31 +1165,43 @@ colorSelectInput <- function(inputId,
 
   choices_new <- stats::setNames(vals, labels)
 
+  if (is.null(selected) || selected == "") {
+    selected <- vals[[1]]
+  }
+
   shiny::selectizeInput(
     inputId  = inputId,
     label    = label,
     choices  = choices_new,
     selected = selected,
     ...,
-    options  = list(
+    options = list(
       render = I(
         "{
-        option: function(item, escape) {
-          item.data = JSON.parse(item.label);
-          return '<div style=\"padding:3px 12px\">' +
-                   '<div><strong>' + escape(item.data.name) + '</strong></div>' +
-                   (item.data.label != '' ? '<div><small>' + escape(item.data.label) + '</small></div>' : '') +
-                   '<div style=\"margin-top:4px\">' + item.data.swatch + '</div>' +
-                 '</div>';
-        },
-        item: function(item, escape) {
-          item.data = JSON.parse(item.label);
-          return '<div style=\"display:flex;align-items:center;gap:6px\">' +
-                   '<span>' + escape(item.data.name) + '</span>' +
-                   item.data.swatch +
-                 '</div>';
-        }
-      }"
+    option: function(item, escape) {
+      item.data = JSON.parse(item.label);
+      return '<div style=\"padding:3px 12px\">' +
+               '<div><strong>' + escape(item.data.name) + '</strong></div>' +
+               (item.data.label != '' ? '<div><small>' + escape(item.data.label) + '</small></div>' : '') +
+               '<div style=\"margin-top:4px\">' + item.data.swatch + '</div>' +
+             '</div>';
+    },
+    item: function(item, escape) {
+      item.data = JSON.parse(item.label);
+      return '<div style=\"display:flex;align-items:center;gap:6px\">' +
+               '<span>' + escape(item.data.name) + '</span>' +
+               item.data.swatch +
+             '</div>';
+    }
+  }"
+      ),
+      onInitialize = I(
+        "function() {
+    var self = this;
+    self.$control_input.prop('readonly', true);
+    self.$control_input.css('cursor', 'default');
+    self.$control.css('cursor', 'pointer');
+  }"
       )
     )
   )
@@ -1862,7 +1882,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
             rlang::exec(cut_var, !!!parameters)
           },
           error = function(err) {
-            showNotification(paste("We encountered the following error creating the new factor:", err), type = "err")
+            showNotification(paste("We encountered the following error creating the new factor:", err), type = "error")
           }
         )
 
@@ -2468,7 +2488,7 @@ data_visuals_server <- function(id,
 
       shiny::observeEvent(input$act_plot, {
         if (NROW(data()) > 0) {
-          tryCatch({
+            tryCatch({
             parameters <- list(
               type = rv$plot.params()[["fun"]],
               pri = input$primary,
@@ -2494,7 +2514,7 @@ data_visuals_server <- function(id,
           #   showNotification(paste0(warn), type = "warning")
           # },
           error = function(err) {
-            showNotification(paste0(err), type = "err")
+            showNotification(paste0(err), type = "error")
           })
         }
       }, ignoreInit = TRUE)
@@ -2717,6 +2737,18 @@ supported_plots <- function() {
       secondary.max = 4,
       tertiary.type = c("dichotomous"),
       secondary.extra = NULL
+    ),
+    plot_euler = list(
+      fun = "plot_likert",
+      descr = i18n$t("Likert diagram"),
+      note = i18n$t(
+        "Plot survey results"
+      ),
+      primary.type = c("dichotomous", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = TRUE,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = NULL
     )
   )
 }
@@ -4303,8 +4335,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 <-
   #
@@ -4914,12 +4946,63 @@ data_types <- function() {
   )
 }
 
+non_character_cols <- function(df) {
+  if (shiny::is.reactive(df)) df <- df()
+  df[, !sapply(df, is.character), drop = FALSE]
+}
+
+apply_idea_filter <- function(filtered_reactive, df_target, env = parent.frame()) {
+  # If this ever brakes, the solution will have to be to modify the original filter function
+  if (shiny::is.reactive(df_target)) df_target <- df_target()
+
+  result      <- if (shiny::is.reactive(filtered_reactive)) filtered_reactive() else filtered_reactive
+  filter_code <- attr(result, "code")
+
+  if (is.null(filter_code)) return(df_target)
+
+  deparsed <- paste(deparse(filter_code), collapse = "")
+
+  if (is.symbol(filter_code) || !grepl("filter(", deparsed, fixed = TRUE)) {
+    return(df_target)
+  }
+
+  extract_filters <- function(code) {
+    filters <- list()
+    while (!is.symbol(code) && deparse(code[[1]]) == "%>%") {
+      rhs <- code[[3]]
+      if (deparse(rhs[[1]]) == "filter") {
+        filters <- c(list(rhs), filters)
+      }
+      code <- code[[2]]
+    }
+    if (!is.symbol(code) && deparse(code[[1]]) == "filter") {
+      filters <- c(list(code), filters)
+    }
+    filters
+  }
+
+  tryCatch({
+    out <- df_target
+    for (f in extract_filters(filter_code)) {
+      args <- lapply(rlang::call_args(f), function(arg) {
+        rlang::new_quosure(arg, env = env)
+      })
+      out <- dplyr::filter(out, !!!args)
+    }
+    out
+  },
+  error = function(e) {
+    warning("Could not apply filter: ", conditionMessage(e))
+    df_target
+  })
+}
+
 
 ########
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v26.3.4-260324'
+hosted_version <- function()'v26.3.5-260330'
 
 
 ########
@@ -5698,7 +5781,7 @@ import_file_server <- function(id,
       #     showNotification(warn, type = "warning")
       # },
       error = function(err) {
-        showNotification(err, type = "err")
+        showNotification(err, type = "error")
       })
     })
 
@@ -5715,7 +5798,7 @@ import_file_server <- function(id,
           minBodyHeight = 250
         )
       }, error = function(err) {
-        showNotification(err, type = "err")
+        showNotification(err, type = "error")
       })
     })
 
@@ -5830,7 +5913,7 @@ import_xls <- function(file, sheet, skip, na.strings) {
   #   showNotification(paste0(warn), type = "warning")
   # },
   error = function(err) {
-    showNotification(paste0(err), type = "err")
+    showNotification(paste0(err), type = "error")
   })
 }
 
@@ -5858,7 +5941,7 @@ import_ods <- function(file, sheet, skip, na.strings) {
   #   showNotification(paste0(warn), type = "warning")
   # },
   error = function(err) {
-    showNotification(paste0(err), type = "err")
+    ?showNotification(paste0(err), type = "error")
   })
 }
 
@@ -6701,7 +6784,7 @@ data_missings_server <- function(id, data, max_level = 20, ...) {
             out <- do.call(compare_missings, modifyList(parameters, list(data = df_tbl)))
           })
         }, error = function(err) {
-          showNotification(paste0("Error: ", err), type = "err")
+          showNotification(paste0("Error: ", err), type = "error")
         })
 
         if (is.null(input$missings_var) ||
@@ -7406,6 +7489,62 @@ vertical_stacked_bars <- function(data,
 }
 
 
+########
+#### Current file: /Users/au301842/FreesearchR/R//plot_likert.R 
+########
+
+#' Nice horizontal bar plot centred on the central category
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @name data-plots
+#'
+#' @examples
+#' mtcars |> plot_likert(pri = "carb", sec = "cyl")
+#' mtcars |> plot_likert(pri = "carb", sec = "cyl", ter="am")
+#' mtcars |> plot_likert(pri = "cyl",color.palette="Blues")
+#' mtcars |> plot_likert(pri = "carb", sec = NULL,color.palette="Magma")
+#' mtcars |> plot_likert(pri = "carb", sec = c("cyl","am"),color.palette="Viridis")
+plot_likert <- function(data,
+                        pri,
+                        sec = NULL,
+                        ter = NULL,
+                        color.palette = "viridis") {
+  if (!is.null(ter)) {
+    ds <- split(data, data[ter])
+  } else {
+    ds <- list(data)
+  }
+  out <- lapply(ds, \(.x) {
+    .x[c(pri, sec)] |>
+      # na.omit() |>
+      plot_likert_single(color.palette = color.palette)
+  })
+
+  wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")))
+}
+
+
+plot_likert_single <- function(data, color.palette = "viridis") {
+  ggstats::gglikert(data = data) +
+    scale_fill_generate(palette=color.palette)+
+    ggplot2::theme(
+      # legend.position = "none",
+      # panel.grid.major = element_blank(),
+      # panel.grid.minor = element_blank(),
+      # axis.text.y = ggplot2::element_blank(),
+      # axis.title.y = ggplot2::element_blank(),
+      text = ggplot2::element_text(size = 12)
+      # axis.text = ggplot2::element_blank(),
+      # plot.title = element_blank(),
+      # panel.background = ggplot2::element_rect(fill = "white"),
+      # plot.background = ggplot2::element_rect(fill = "white"),
+      # panel.border = ggplot2::element_blank()
+    )
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//plot_ridge.R 
 ########
@@ -7990,10 +8129,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
   ns <- shiny::NS(id)
 
   if (isTRUE(title)) {
-    title <- shiny::tags$h4(
-      i18n$t("Import data from REDCap"),
-      class = "redcap-module-title"
-    )
+    title <- shiny::tags$h4(i18n$t("Import data from REDCap"), class = "redcap-module-title")
   }
 
   server_ui <- shiny::tagList(
@@ -8004,7 +8140,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       value = if_not_missing(url, "https://redcap.your.institution/"),
       width = "100%"
     ),
-    shiny::helpText(i18n$t("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'")),
+    shiny::helpText(
+      i18n$t(
+        "Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
+      )
+    ),
     shiny::br(),
     shiny::br(),
     shiny::passwordInput(
@@ -8013,7 +8153,9 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       value = "",
       width = "100%"
     ),
-    shiny::helpText(i18n$t("The token is a string of 32 numbers and letters.")),
+    shiny::helpText(i18n$t(
+      "The token is a string of 32 numbers and letters."
+    )),
     shiny::br(),
     shiny::br(),
     shiny::actionButton(
@@ -8030,7 +8172,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shinyWidgets::alert(
         id = ns("connect-result"),
         status = "info",
-        tags$p(phosphoricons::ph("info", weight = "bold"), i18n$t("Please fill in web address and API token, then press 'Connect'."))
+        tags$p(
+          phosphoricons::ph("info", weight = "bold"),
+          i18n$t("Please fill in web address and API token, then press 'Connect'.")
+        )
       ),
       dismissible = TRUE
     ),
@@ -8043,14 +8188,18 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shiny::uiOutput(outputId = ns("arms")),
       shiny::textInput(
         inputId = ns("filter"),
-        label = i18n$t("Optional filter logic (e.g., ⁠[gender] = 'female')"
-      ))
+        label = i18n$t("Optional filter logic (e.g., ⁠[gender] = 'female')")
+      ),
+      uiOutput(ns("filter_feedback"))
     )
 
   params_ui <-
     shiny::tagList(
       shiny::tags$h4(i18n$t("Data import parameters")),
       shiny::tags$div(
+        ####
+        #### All below was deactivated to deactivate filtering
+        ####
         style = htmltools::css(
           display = "grid",
           gridTemplateColumns = "1fr 50px",
@@ -8075,7 +8224,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
           )
         )
       ),
-      shiny::helpText(i18n$t("Select fields/variables to import and click the funnel to apply optional filters")),
+      shiny::helpText(
+        i18n$t(
+          "Select fields/variables to import and click the funnel to apply optional filters"
+        )
+      ),
       shiny::tags$br(),
       shiny::tags$br(),
       shiny::uiOutput(outputId = ns("data_type")),
@@ -8094,7 +8247,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
         shinyWidgets::alert(
           id = ns("retrieved-result"),
           status = "info",
-          tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
+          tags$p(
+            phosphoricons::ph("info", weight = "bold"),
+            "Please specify data to download, then press 'Import'."
+          )
         ),
         dismissible = TRUE
       )
@@ -8105,11 +8261,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
     title = title,
     server_ui,
     # shiny::uiOutput(ns("params_ui")),
-    shiny::conditionalPanel(
-      condition = "output.connect_success == true",
-      params_ui,
-      ns = ns
-    ),
+    shiny::conditionalPanel(condition = "output.connect_success == true", params_ui, ns = ns),
     shiny::br()
   )
 }
@@ -8134,14 +8286,19 @@ m_redcap_readServer <- function(id) {
       dd_list = NULL,
       data = NULL,
       rep_fields = NULL,
-      code = NULL
+      code = NULL,
+      filter_valid = NULL
     )
 
     shiny::observeEvent(list(input$api, input$uri), {
       shiny::req(input$api)
       shiny::req(input$uri)
       if (!is.null(input$uri)) {
-        uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
+        uri <- paste0(ifelse(
+          endsWith(input$uri, "/"),
+          input$uri,
+          paste0(input$uri, "/")
+        ), "api/")
       } else {
         uri <- input$uri
       }
@@ -8155,75 +8312,68 @@ m_redcap_readServer <- function(id) {
     })
 
 
-    tryCatch(
-      {
-        shiny::observeEvent(
-          list(
-            input$data_connect
-          ),
-          {
-            shiny::req(input$api)
-            shiny::req(data_rv$uri)
+    tryCatch({
+      shiny::observeEvent(list(input$data_connect), {
+        shiny::req(input$api)
+        shiny::req(data_rv$uri)
 
-            parameters <- list(
-              redcap_uri = data_rv$uri,
-              token = input$api
-            )
+        parameters <- list(redcap_uri = data_rv$uri, token = input$api)
 
-            # browser()
-            shiny::withProgress(
-              {
-                imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
-              },
-              message = paste("Connecting to", data_rv$uri)
-            )
+        # browser()
+        shiny::withProgress({
+          imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters),
+                          silent = TRUE)
+        }, message = paste("Connecting to", data_rv$uri))
 
-            ## TODO: Simplify error messages
-            if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
-              if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
-                mssg <- imported$raw_text
-              } else {
-                mssg <- attr(imported, "condition")$message
-              }
+        ## TODO: Simplify error messages
+        if (inherits(imported, "try-error") ||
+            NROW(imported) < 1 ||
+            ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
+          if (ifelse(is.list(imported),
+                     !isTRUE(imported$success),
+                     FALSE)) {
+            mssg <- imported$raw_text
+          } else {
+            mssg <- attr(imported, "condition")$message
+          }
 
-              datamods:::insert_error(mssg = mssg, selector = "connect")
-              data_rv$dd_status <- "error"
-              data_rv$dd_list <- NULL
-            } else if (isTRUE(imported$success)) {
-              data_rv$dd_status <- "success"
+          datamods:::insert_error(mssg = mssg, selector = "connect")
+          data_rv$dd_status <- "error"
+          data_rv$dd_list <- NULL
+        } else if (isTRUE(imported$success)) {
+          data_rv$dd_status <- "success"
 
-              data_rv$info <- REDCapR::redcap_project_info_read(
-                redcap_uri = data_rv$uri,
-                token = input$api
-              )$data
+          data_rv$info <- REDCapR::redcap_project_info_read(redcap_uri = data_rv$uri, token = input$api)$data
 
-              datamods:::insert_alert(
-                selector = ns("connect"),
-                status = "success",
-                include_data_alert(
-                  see_data_text = i18n$t("Click to see data dictionary"),
-                  dataIdName = "see_dd",
-                  extra = tags$p(
-                    tags$b(phosphoricons::ph("check", weight = "bold"), i18n$t("Connected to server!")),
-                    glue::glue(i18n$t("The {data_rv$info$project_title} project is loaded."))
-                  ),
-                  btn_show_data = TRUE
+          datamods:::insert_alert(
+            selector = ns("connect"),
+            status = "success",
+            include_data_alert(
+              see_data_text = i18n$t("Click to see data dictionary"),
+              dataIdName = "see_dd",
+              extra = tags$p(
+                tags$b(
+                  phosphoricons::ph("check", weight = "bold"),
+                  i18n$t("Connected to server!")
+                ),
+                glue::glue(
+                  i18n$t(
+                    "The {data_rv$info$project_title} project is loaded."
+                  )
                 )
-              )
+              ),
+              btn_show_data = TRUE
+            )
+          )
 
-              data_rv$dd_list <- imported
-            }
-          },
-          ignoreInit = TRUE
-        )
-      },
-      warning = function(warn) {
-        showNotification(paste0(warn), type = "warning")
-      },
-      error = function(err) {
-        showNotification(paste0(err), type = "err")
-      }
-    )
+          data_rv$dd_list <- imported
+        }
+      }, ignoreInit = TRUE)
+    }, warning = function(warn) {
+      showNotification(paste0(warn), type = "warning")
+    }, error = function(err) {
+      showNotification(paste0(err), type = "error")
+    })
 
     output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
     shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
@@ -8254,10 +8404,7 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$api)
       shiny::req(data_rv$uri)
 
-      REDCapR::redcap_event_read(
-        redcap_uri = data_rv$uri,
-        token = input$api
-      )$data
+      REDCapR::redcap_event_read(redcap_uri = data_rv$uri, token = input$api)$data
     })
 
     output$fields <- shiny::renderUI({
@@ -8267,7 +8414,7 @@ m_redcap_readServer <- function(id) {
         label = i18n$t("Select fields/variables to import:"),
         choices = purrr::pluck(data_rv$dd_list, "data") |>
           dplyr::select(field_name, form_name) |>
-          (\(.x){
+          (\(.x) {
             split(.x$field_name, REDCapCAST::as_factor(.x$form_name))
           })(),
         updateOn = "change",
@@ -8300,14 +8447,10 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$data_type)
 
       ## Get repeated field
-      data_rv$rep_fields <- data_rv$dd_list$data$field_name[
-        data_rv$dd_list$data$form_name %in% repeated_instruments(
-          uri = data_rv$uri,
-          token = input$api
-        )
-      ]
+      data_rv$rep_fields <- data_rv$dd_list$data$field_name[data_rv$dd_list$data$form_name %in% repeated_instruments(uri = data_rv$uri, token = input$api)]
 
-      if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
+      if (input$data_type == "long" &&
+          isTRUE(any(input$fields %in% data_rv$rep_fields))) {
         vectorSelectInput(
           inputId = ns("fill"),
           label = i18n$t("Fill missing values?"),
@@ -8343,12 +8486,48 @@ m_redcap_readServer <- function(id) {
       }
     })
 
+
+    filter_validation <- reactive({
+      val <- trimws(input$filter)
+      if (nchar(val) == 0)
+        return(NULL)
+      validate_redcap_filter(val, purrr::pluck(data_rv$dd_list, "data"))
+    })
+
+    output$filter_feedback <- renderUI({
+      result <- filter_validation()
+      if (is.null(result)) {
+        data_rv$filter_valid <- NULL
+        return(NULL)
+      }
+
+      if (result$valid) {
+        data_rv$filter_valid <- TRUE
+        tags$span(style = "color: green;", "\u2713 Filter is valid")
+      } else {
+        data_rv$filter_valid <- FALSE
+
+        tags$span(style = "color: red;",
+                  "\u2717 ",
+                  line_break(result$message, lineLength = 30))
+      }
+    })
+
     shiny::observeEvent(input$data_import, {
       shiny::req(input$fields)
 
       # browser()
       record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
 
+      if (!is.null(data_rv$filter_valid)) {
+        if (isTRUE(data_rv$filter_valid)) {
+          filter <- trimws(input$filter)
+        } else {
+          filter <- ""
+        }
+      } else {
+        filter <- ""
+      }
 
       parameters <- list(
         uri = data_rv$uri,
@@ -8356,7 +8535,8 @@ m_redcap_readServer <- function(id) {
         fields = unique(c(record_id, input$fields)),
         events = input$arms,
         raw_or_label = "both",
-        filter_logic = input$filter,
+        filter_logic = filter,
+        # filter_logic = "",
         split_forms = ifelse(
           input$data_type == "long" && !is.null(input$data_type),
           "none",
@@ -8365,31 +8545,48 @@ m_redcap_readServer <- function(id) {
       )
 
       shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
-        imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
+        imported <- try({
+          rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters)
+          # if (nrow(out)==0){
+          #   stop("No data was exported")
+          # } else {
+          #   out
+          # }
+        }, # error = function(err) {
+        #   showNotification(i18n$t("An error was encountered exporting data. Please review data filter."), type = "error")
+        # },
+        silent = TRUE)
       })
 
-      parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
+      # d <- REDCapCAST::apply_factor_labels(data = imported$survey, meta = data_rv$dd_list$data)
 
-      code <- rlang::call2(
-        "easy_redcap",
-        !!!utils::modifyList(
-          parameters_code,
-          list(
-            data_format = ifelse(
-              input$data_type == "long" && !is.null(input$data_type),
-              "long",
-              "wide"
-            ),
-            project.name = simple_snake(data_rv$info$project_title)
-          )
-        ),
-        .ns = "REDCapCAST"
-      )
+      parameters_code <- parameters[c("uri",
+                                      "fields",
+                                      "events",
+                                      "raw_or_label",
+                                      "filter_logic")]
 
-      if (inherits(imported, "try-error") || NROW(imported) < 1) {
+      code <- rlang::call2("easy_redcap",
+                           !!!utils::modifyList(
+                             parameters_code,
+                             list(
+                               data_format = ifelse(
+                                 input$data_type == "long" && !is.null(input$data_type),
+                                 "long",
+                                 "wide"
+                               ),
+                               project.name = simple_snake(data_rv$info$project_title)
+                             )
+                           ),
+                           .ns = "REDCapCAST")
+
+      if (inherits(imported, "try-error") |
+          NROW(imported) == 0 |
+          (length(imported) == 1 & !is.list(imported))) {
         data_rv$data_status <- "error"
         data_rv$data_list <- NULL
-        data_rv$data_message <- imported$raw_text
+        data_rv$data_message <- i18n$t("An empty data set was imported. Please review data filter.")
+        data_rv$data <- NULL
       } else {
         data_rv$data_status <- "success"
         data_rv$data_message <- i18n$t("Requested data was retrieved!")
@@ -8398,12 +8595,11 @@ m_redcap_readServer <- function(id) {
         ## "wide"/"long" without re-importing data
 
         if (parameters$split_form == "all") {
-          # browser()
           out <- imported |>
             # redcap_wider()
             REDCapCAST::redcap_wider()
         } else {
-          if (input$fill == "yes") {
+          if (identical(input$fill, "yes")) {
             ## Repeated fields
 
 
@@ -8421,78 +8617,102 @@ m_redcap_readServer <- function(id) {
           }
         }
 
-        # browser()
+        ## Ensure correct factor labels
+        ## It is a little hacky and should be included in the read_redcap_tables, but is lost along the way
+        out <- REDCapCAST::apply_factor_labels(data = out, meta = data_rv$dd_list$data)
+
+
         in_data_check <- parameters$fields %in% names(out) |
-          sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
+          sapply(names(out), \(.x) any(sapply(
+            parameters$fields, \(.y) startsWith(.x, .y)
+          )))
 
         if (!any(in_data_check[-1])) {
           data_rv$data_status <- "warning"
-          data_rv$data_message <- i18n$t("Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
+          data_rv$data_message <- i18n$t(
+            "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+          )
         }
 
         if (!all(in_data_check)) {
           data_rv$data_status <- "warning"
-          data_rv$data_message <- i18n$t("Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
+          data_rv$data_message <- i18n$t(
+            "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+          )
         }
 
         data_rv$code <- code
 
+        ## Level labels nare lost at this point...
         data_rv$data <- out |>
           dplyr::select(-dplyr::ends_with("_complete")) |>
           # dplyr::select(-dplyr::any_of(record_id)) |>
           REDCapCAST::suffix2label()
+
       }
     })
 
-    shiny::observeEvent(
-      data_rv$data_status,
-      {
-        # browser()
-        if (identical(data_rv$data_status, "error")) {
-          datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
-        } else if (identical(data_rv$data_status, "success")) {
-          datamods:::insert_alert(
-            selector = ns("retrieved"),
-            status = data_rv$data_status,
-            # tags$p(
-            #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
-            #   data_rv$data_message
-            # ),
-            include_data_alert(
-              see_data_text = i18n$t("Click to see the imported data"),
-              dataIdName = "see_data",
-              extra = tags$p(
-                tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
-              ),
-              btn_show_data = TRUE
-            )
+    shiny::observeEvent(data_rv$data_status, {
+      if (identical(data_rv$data_status, "error")) {
+        ## The insert error wouldn't work. Inserted through regular.
+        # datamods:::insert_error(mssg = data_rv$data_message,
+        #                         selector = ns("retrieved"))
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = "danger",
+          tags$p(
+            tags$b(
+              phosphoricons::ph("warning", weight = "bold"),
+              "Warning!"
+            ),
+            data_rv$data_message
           )
-        } else {
-          datamods:::insert_alert(
-            selector = ns("retrieved"),
-            status = data_rv$data_status,
-            tags$p(
-              tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
+        )
+      } else if (identical(data_rv$data_status, "success")) {
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = data_rv$data_status,
+          # tags$p(
+          #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+          #   data_rv$data_message
+          # ),
+          include_data_alert(
+            see_data_text = i18n$t("Click to see the imported data"),
+            dataIdName = "see_data",
+            extra = tags$p(tags$b(
+              phosphoricons::ph("check", weight = "bold"),
               data_rv$data_message
-            )
+            )),
+            btn_show_data = TRUE
           )
-        }
+        )
+      } else {
+        datamods:::insert_alert(
+          selector = ns("retrieved"),
+          status = data_rv$data_status,
+          tags$p(
+            tags$b(
+              phosphoricons::ph("warning", weight = "bold"),
+              "Warning!"
+            ),
+            data_rv$data_message
+          )
+        )
       }
-    )
+    })
 
-    return(list(
-      status = shiny::reactive(data_rv$data_status),
-      name = shiny::reactive(data_rv$info$project_title),
-      info = shiny::reactive(data_rv$info),
-      code = shiny::reactive(data_rv$code),
-      data = shiny::reactive(data_rv$data)
-    ))
+    return(
+      list(
+        status = shiny::reactive(data_rv$data_status),
+        name = shiny::reactive(data_rv$info$project_title),
+        info = shiny::reactive(data_rv$info),
+        code = shiny::reactive(data_rv$code),
+        data = shiny::reactive(data_rv$data)
+      )
+    )
   }
 
-  shiny::moduleServer(
-    id = id,
-    module = module
-  )
+  shiny::moduleServer(id = id, module = module)
 }
 
 #' @importFrom htmltools tagList tags
@@ -8503,14 +8723,12 @@ include_data_alert <- function(dataIdName = "see_data",
                                extra = NULL,
                                session = shiny::getDefaultReactiveDomain()) {
   if (isTRUE(btn_show_data)) {
-    success_message <- tagList(
-      extra,
-      tags$br(),
-      shiny::actionLink(
-        inputId = session$ns(dataIdName),
-        label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
-      )
-    )
+    success_message <- tagList(extra,
+                               tags$br(),
+                               shiny::actionLink(
+                                 inputId = session$ns(dataIdName),
+                                 label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
+                               ))
   }
   return(success_message)
 }
@@ -8562,20 +8780,18 @@ is_valid_redcap_url <- function(url) {
 #' @examples
 #' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
 #' is_valid_token(token)
-is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
+is_valid_token <- function(token,
+                           pattern_env = NULL,
+                           nchar = 32) {
   checkmate::assert_character(token, any.missing = TRUE, len = 1)
 
   if (!is.null(pattern_env)) {
-    checkmate::assert_character(pattern_env,
-      any.missing = FALSE,
-      len = 1
-    )
+    checkmate::assert_character(pattern_env, any.missing = FALSE, len = 1)
     pattern <- pattern_env
   } else {
     pattern <- glue::glue("^([0-9A-Fa-f]{<nchar>})(?:\\n)?$",
-      .open = "<",
-      .close = ">"
-    )
+                          .open = "<",
+                          .close = ">")
   }
 
   if (is.na(token)) {
@@ -8615,10 +8831,15 @@ repeated_instruments <- function(uri, token) {
 #' @export
 #'
 drop_empty_event <- function(data, event = "redcap_event_name") {
-  generics <- c(names(data)[1], "redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
+  generics <- c(
+    names(data)[1],
+    "redcap_event_name",
+    "redcap_repeat_instrument",
+    "redcap_repeat_instance"
+  )
 
   filt <- split(data, data[[event]]) |>
-    lapply(\(.x){
+    lapply(\(.x) {
       dplyr::select(.x, -tidyselect::all_of(generics)) |>
         REDCapCAST::all_na()
     }) |>
@@ -8628,6 +8849,327 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
 }
 
 
+#' Validate a REDCap server-side filter string against a data dictionary
+#'
+#' Checks that a REDCap filter expression is syntactically correct and
+#' consistent with the field types defined in the project data dictionary.
+#' Plain text without field references is always rejected. Multi-clause
+#' filters joined by \code{AND} or \code{OR} are supported.
+#'
+#' @param filter A single character string containing the filter expression,
+#'   e.g. \code{"[age] > 18"} or \code{"[cohabitation] = '1' AND [age] > 18"}.
+#' @param dictionary A data frame representing the REDCap data dictionary in
+#'   API export format, as returned by e.g. \code{REDCapCAST::get_redcap_metadata()}.
+#'   Must contain at least the columns \code{field_name} and \code{field_type}.
+#'   The columns \code{text_validation_type_or_show_slider_number} and
+#'   \code{select_choices_or_calculations} are used when present for stricter
+#'   type and choice validation.
+#'
+#' @return A named list with two elements:
+#'   \describe{
+#'     \item{\code{valid}}{Logical. \code{TRUE} if the filter passes all checks.}
+#'     \item{\code{message}}{Character. \code{"Filter is valid."} on success, or
+#'       a newline-separated string of error messages describing every problem
+#'       found.}
+#'   }
+#'
+#' @details
+#' Validation rules by field type:
+#' \describe{
+#'   \item{\code{calc}}{Numeric fields. Value must be an unquoted number.
+#'     All comparison operators (\code{=}, \code{!=}, \code{<}, \code{>},
+#'     \code{<=}, \code{>=}) are accepted.}
+#'   \item{\code{text} with date validation}{Fields with validation type
+#'     \code{date_ymd}, \code{date_dmy}, \code{datetime_*}, etc. Value must be
+#'     a quoted date/datetime string in \code{'YYYY-MM-DD'} format. All
+#'     comparison operators are accepted.}
+#'   \item{\code{text} with time validation}{Fields with validation type
+#'     \code{time_hh_mm_ss} or \code{time_mm_ss}. Value must be a quoted time
+#'     string, e.g. \code{'14:30:00'}. All comparison operators are accepted.}
+#'   \item{\code{radio} / \code{dropdown}}{Categorical fields. Value must be a
+#'     quoted choice code (e.g. \code{'1'}) that exists in the field's choice
+#'     list. Only \code{=} and \code{!=} are accepted.}
+#'   \item{\code{text} (plain)}{Free-text fields. Value must be a quoted string.
+#'     Only \code{=} and \code{!=} are accepted.}
+#' }
+#'
+#' @examples
+#' \dontrun{
+#' dict <- REDCapCAST::get_redcap_metadata(
+#'   uri    = "https://redcap.example.com/api/",
+#'   token  = Sys.getenv("REDCAP_TOKEN")
+#' )
+#'
+#' validate_redcap_filter("[age] > 18", dict)
+#' #> list(valid = TRUE, message = "Filter is valid.")
+#'
+#' validate_redcap_filter("only plain text", dict)
+#' #> list(valid = FALSE, message = "Filter must contain at least one field ...")
+#'
+#' validate_redcap_filter("[cohabitation] = '1' AND [age] > 18", dict)
+#' #> list(valid = TRUE, message = "Filter is valid.")
+#' }
+#'
+#' @export
+# REDCap filter validation based on data dictionary
+#
+# REDCap filter format: [field_name] operator value
+# Example: [age] > 18
+#          [cohabitation] = '1'
+#          [inclusion] > '2020-01-01'
+#
+# Supported field types and their allowed operators/value formats:
+#   text (no validation) -> string values, = != operators only
+#   text (date_ymd/date_dmy) -> quoted date strings, all comparison operators
+#   text (time_hh_mm_ss) -> quoted time strings, all comparison operators
+#   text (datetime_*) -> quoted datetime strings, all comparison operators
+#   text (autocomplete) -> string values, = != operators only
+#   calc -> numeric values, all comparison operators
+#   radio/dropdown -> quoted numeric codes, = != operators only
+
+validate_redcap_filter <- function(filter, dictionary) {
+  # --- Input checks ---
+  if (!is.character(filter) ||
+      length(filter) != 1 || nchar(trimws(filter)) == 0) {
+    return(list(valid = FALSE, message = "Filter must be a non-empty string."))
+  }
+
+  if (!grepl("\\[.+\\]", filter)) {
+    return(
+      list(valid = FALSE, message = "Filter must contain at least one field reference in [brackets]. Plain text is not accepted.")
+    )
+  }
+
+  # --- Column names (API export format) ---
+  col_field    <- "field_name"
+  col_type     <- "field_type"
+  col_val_type <- "text_validation_type_or_show_slider_number"
+  col_choices  <- "select_choices_or_calculations"
+
+  missing_cols <- setdiff(c(col_field, col_type), names(dictionary))
+  if (length(missing_cols) > 0) {
+    stop("Dictionary is missing required columns: ",
+         paste(missing_cols, collapse = ", "))
+  }
+
+  # --- Build lookup index once for O(1) field access ---
+  field_idx    <- setNames(seq_len(nrow(dictionary)), dictionary[[col_field]])
+  has_val_type <- col_val_type %in% names(dictionary)
+  has_choices  <- col_choices  %in% names(dictionary)
+
+  # --- Classify field types ---
+  numeric_types    <- c("calc")
+  date_validations <- c(
+    "date_ymd",
+    "date_dmy",
+    "datetime_ymd",
+    "datetime_dmy",
+    "datetime_seconds_ymd",
+    "datetime_seconds_dmy"
+  )
+  time_validations <- c("time_hh_mm_ss", "time_mm_ss")
+  categorical_types <- c("radio", "dropdown", "checkbox")
+  text_types        <- c("text", "autocomplete")
+
+  num_ops  <- c("=", "!=", "<", ">", "<=", ">=")
+  cat_ops  <- c("=", "!=")
+  text_ops <- c("=", "!=")
+
+  # --- Parse filter into clauses ---
+  # Split on AND/OR (REDCap uses 'and'/'or' or 'AND'/'OR')
+  clauses <- trimws(strsplit(filter, "(?i)\\s+(and|or)\\s+", perl = TRUE)[[1]])
+
+  clause_pattern <- "^\\[([^\\]]+)\\]\\s*(=|!=|<=|>=|<|>)\\s*(.+)$"
+
+  errors <- character(0)
+
+  for (clause in clauses) {
+    if (!grepl(clause_pattern, clause, perl = TRUE)) {
+      errors <- c(
+        errors,
+        sprintf(
+          "Clause '%s' does not match expected format: [field] operator value",
+          clause
+        )
+      )
+      next
+    }
+
+    parts    <- regmatches(clause, regexec(clause_pattern, clause, perl = TRUE))[[1]]
+    field    <- parts[2]
+    operator <- parts[3]
+    value    <- trimws(parts[4])
+
+    # --- Check field exists using pre-built index ---
+    row_i <- field_idx[field]
+    if (is.na(row_i)) {
+      errors <- c(errors, sprintf("Unknown field: [%s]", field))
+      next
+    }
+
+    field_type <- dictionary[[col_type]][row_i]
+    val_type   <- if (has_val_type)
+      dictionary[[col_val_type]][row_i]
+    else
+      ""
+    if (is.na(val_type))
+      val_type <- ""
+
+    # --- Determine expected value format and allowed operators ---
+    if (field_type %in% numeric_types ||
+        grepl("^integer$|^number", val_type)) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is numeric — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^-?[0-9]+(\\.[0-9]+)?$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is numeric — value '%s' should be an unquoted number (e.g. 18 or 3.5)",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (val_type %in% date_validations) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a date — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl(
+        "^'[0-9]{4}-[0-9]{2}-[0-9]{2}(\\s[0-9]{2}:[0-9]{2}(:[0-9]{2})?)?'$",
+        value
+      )) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a date — value '%s' should be a quoted date string, e.g. '2020-01-31'",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (val_type %in% time_validations) {
+      if (!operator %in% num_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a time — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(num_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^'[0-9]{2}:[0-9]{2}(:[0-9]{2})?'$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a time — value '%s' should be a quoted time string, e.g. '14:30:00'",
+            field,
+            value
+          )
+        )
+      }
+
+    } else if (field_type %in% categorical_types) {
+      if (!operator %in% cat_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is categorical — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(cat_ops, collapse = ", ")
+          )
+        )
+      }
+
+      # Validate value is a known choice code
+      choices_raw <- if (has_choices)
+        dictionary[[col_choices]][row_i]
+      else
+        NA
+      if (!is.na(choices_raw) && nchar(trimws(choices_raw)) > 0) {
+        choice_codes <- trimws(gsub(",.+?(\\||$)", "", gsub(
+          "^\\s*", "", strsplit(choices_raw, "\\|")[[1]]
+        )))
+        value_unquoted <- gsub("^'|'$", "", value)
+        if (!value_unquoted %in% choice_codes) {
+          errors <- c(
+            errors,
+            sprintf(
+              "[%s] is categorical — '%s' is not a valid choice code. Valid codes: %s",
+              field,
+              value_unquoted,
+              paste(choice_codes, collapse = ", ")
+            )
+          )
+        }
+      }
+
+      if (!grepl("^'.*'$", value)) {
+        errors <- c(errors,
+                    sprintf(
+                      "[%s] is categorical — value should be quoted, e.g. '1'",
+                      field
+                    ))
+      }
+
+    } else {
+      # Plain text field
+      if (!operator %in% text_ops) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a text field — operator '%s' is not valid. Use one of: %s",
+            field,
+            operator,
+            paste(text_ops, collapse = ", ")
+          )
+        )
+      }
+      if (!grepl("^'.*'$", value)) {
+        errors <- c(
+          errors,
+          sprintf(
+            "[%s] is a text field — value should be quoted, e.g. 'some text'",
+            field
+          )
+        )
+      }
+    }
+  }
+
+  if (length(errors) > 0) {
+    return(list(
+      valid = FALSE,
+      message = paste(errors, collapse = "\n")
+    ))
+  }
+
+  list(valid = TRUE, message = "Filter is valid.")
+}
+
+
+
 #' Test app for the redcap_read_shiny_module
 #'
 #' @rdname redcap_read_shiny_module
@@ -8646,16 +9188,10 @@ redcap_demo_app <- function() {
   server <- function(input, output, session) {
     data_val <- m_redcap_readServer(id = "data")
 
-    output$data <- DT::renderDataTable(
-      {
-        shiny::req(data_val$data)
-        data_val$data()
-      },
-      options = list(
-        scrollX = TRUE,
-        pageLength = 5
-      ),
-    )
+    output$data <- DT::renderDataTable({
+      shiny::req(data_val$data)
+      data_val$data()
+    }, options = list(scrollX = TRUE, pageLength = 5), )
     output$code <- shiny::renderPrint({
       shiny::req(data_val$code)
       data_val$code()
@@ -10054,7 +10590,7 @@ regression_server <- function(id,
               rv$list$regression$models <- model_lists
             },
             error = function(err) {
-              showNotification(paste(i18n$t("Creating regression models failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Creating regression models failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -10119,7 +10655,7 @@ regression_server <- function(id,
               showNotification(paste0(warn), type = "warning")
             },
             error = function(err) {
-              showNotification(paste(i18n$t("Creating a regression table failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Creating a regression table failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -10197,7 +10733,7 @@ regression_server <- function(id,
               gg_theme_shiny()
           },
           error = function(err) {
-            showNotification(paste0(err), type = "err")
+            showNotification(paste0(err), type = "error")
           }
         )
       })
@@ -10257,7 +10793,7 @@ regression_server <- function(id,
             #   showNotification(paste0(warn), type = "warning")
             # },
             error = function(err) {
-              showNotification(paste(i18n$t("Running model assumptions checks failed with the following error:"), err), type = "err")
+              showNotification(paste(i18n$t("Running model assumptions checks failed with the following error:"), err), type = "error")
             }
           )
         }
@@ -10328,7 +10864,7 @@ regression_server <- function(id,
                 out <- patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
               },
               error = function(err) {
-                showNotification(err, type = "err")
+                showNotification(err, type = "error")
               }
             )
 
@@ -11998,15 +12534,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",
@@ -12039,7 +12586,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,
@@ -12094,6 +12643,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
@@ -12177,7 +12740,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)))
         })
@@ -12187,7 +12750,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
           "We encountered the following error creating the new factor:",
           err
         ),
-        type = "err")
+        type = "error")
       })
 
       # browser()
@@ -12341,6 +12904,15 @@ unique_names <- function(new, existing = character()) {
 }
 
 
+has_empty_levels <- function(x) {
+  if (is.factor(x)) {
+    any(!levels(x) %in% x)
+  } else {
+    return(FALSE)
+  }
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R 
 ########
@@ -14871,7 +15443,7 @@ server <- function(input, output, session) {
       showNotification(paste(
         i18n$t("We encountered the following error showing missingness:"),
         err
-      ), type = "err")
+      ), type = "error")
     })
   })
 
@@ -15128,6 +15700,7 @@ server <- function(input, output, session) {
       inputId = "column_filter",
       label = i18n$t("Select data types to include"),
       selected = unique(data_type(rv$data)),
+      #[unique(data_type(rv$data))!="text"],
       choices = unique(data_type(rv$data)),
       updateOn = "change",
       multiple = TRUE,
@@ -15220,48 +15793,58 @@ server <- function(input, output, session) {
   #########  Data filter
   # IDEAFilter has the least cluttered UI, but might have a License issue
   # Consider using shinyDataFilter, though not on CRAN
-  data_filter <- IDEAFilter::IDEAFilter(
+  data_filter_raw <- IDEAFilter::IDEAFilter(
     "data_filter",
-    data = shiny::reactive(rv$data_variables),
+    data = shiny::reactive(non_character_cols(rv$data_variables)),
     verbose = TRUE
   )
 
-  shiny::observeEvent(list(
-    shiny::reactive(rv$data_variables),
-    shiny::reactive(rv$data_original),
-    data_filter(),
-    # regression_vars(),
-    input$complete_cutoff
-  ),
-  {
-    ###  Save filtered data
-    rv$data_filtered <- data_filter()
-
-    ###  Save filtered data
-    ###  without empty factor levels
-    rv$list$data <- data_filter() |>
-      REDCapCAST::fct_drop() |>
-      (\(.x) {
-        .x[!sapply(.x, is.character)]
-      })()
-
-    ## This looks messy!! But it works as intended for now
-
-    out <- gsub("filter", "dplyr::filter", gsub("\\s{2,}", " ", paste0(capture.output(
-      attr(rv$data_filtered, "code")
-    ), collapse = " ")))
-
-    out <- strsplit(out, "%>%") |>
-      unlist() |>
-      (\(.x) {
-        paste(c("df <- df", .x[-1], "REDCapCAST::fct_drop()"), collapse = "|> \n ")
-      })()
-
-    rv$code <- append_list(data = out,
-                           list = rv$code,
-                           index = "filter")
+  data_filter <- reactive({
+    apply_idea_filter(data_filter_raw, rv$data_variables)
   })
 
+  shiny::observeEvent(
+    list(
+      shiny::reactive(rv$data_variables),
+      shiny::reactive(rv$data_original),
+      data_filter_raw(),
+      # regression_vars(),
+      input$complete_cutoff
+    ),
+    {
+      ###  Save filtered data
+      # browser()
+      # rv$data_filtered <- apply_idea_filter(data_filter_raw, rv$data_variables)()
+      rv$data_filtered <- data_filter()
+
+      ###  Save filtered data
+      ###  ~~without empty factor levels~~
+      ###  All factor levels are kept, but can be manually removed
+      # browser()
+      rv$list$data <- rv$data_filtered #|>
+      # # REDCapCAST::fct_drop() |>
+      # (\(.x) {
+      #   .x[!sapply(.x, is.character)]
+      # })()
+
+      ## This looks messy!! But it works as intended for now
+      # browser()
+      out <- gsub("filter", "dplyr::filter", gsub("\\s{2,}", " ", paste0(capture.output(
+        attr(data_filter_raw(), "code")
+      ), collapse = " ")))
+
+      out <- strsplit(out, "%>%") |>
+        unlist() |>
+        (\(.x) {
+          paste(c("df <- df", .x[-1]), collapse = "|> \n ")
+        })()
+
+      rv$code <- append_list(data = out,
+                             list = rv$code,
+                             index = "filter")
+    }
+  )
+
   #########  Data preview
 
   ###  Overview
@@ -15279,7 +15862,7 @@ server <- function(input, output, session) {
   observeEvent(input$modal_browse, {
     tryCatch({
       show_data(
-        REDCapCAST::fct_drop(rv$data_filtered),
+        rv$data_filtered,
         title = i18n$t("Uploaded data overview"),
         type = "modal"
       )
@@ -15287,7 +15870,7 @@ server <- function(input, output, session) {
       showNotification(paste(
         i18n$t("We encountered the following error browsing your data:"),
         err
-      ), type = "err")
+      ), type = "error")
     })
   })
 
@@ -15313,7 +15896,7 @@ server <- function(input, output, session) {
       showNotification(paste(
         i18n$t("We encountered the following error showing missingness:"),
         err
-      ), type = "err")
+      ), type = "error")
     })
   })
 
@@ -15520,7 +16103,7 @@ server <- function(input, output, session) {
     #     }
     #   },
     #   error = function(err) {
-    #     showNotification(err, type = "err")
+    #     showNotification(err, type = "error")
     #   }
     # )
 
@@ -15679,7 +16262,7 @@ server <- function(input, output, session) {
               "We encountered the following error creating your report: "
             ),
             err
-          ), type = "err")
+          ), type = "error")
         })
       })
       file.rename(paste0("www/report.", type), file)