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.2
+version: 26.3.1
 doi: 10.5281/zenodo.14527429
 identifiers:
 - type: url

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FreesearchR
 Title: Easy data analysis for clinicians
-Version: 26.3.3
+Version: 26.3.1
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154")),
@@ -139,7 +139,6 @@ Collate:
     'ui_elements.R'
     'update-factor-ext.R'
     'update-variables-ext.R'
-    'utils-labels.R'
     'validation.R'
     'visual_summary.R'
     'wide2long.R'

NAMESPACE

@@ -14,7 +14,6 @@ export(all_but)
 export(allowed_operations)
 export(append_column)
 export(append_list)
-export(apply_labels)
 export(argsstring2list)
 export(baseline_table)
 export(class_icons)
@@ -54,7 +53,6 @@ export(default_parsing)
 export(detect_delimiter)
 export(drop_empty_event)
 export(expression_string)
-export(extract_labels)
 export(factor_new_levels_labels)
 export(factorize)
 export(file_export)
@@ -87,7 +85,6 @@ export(is_identical_to_previous)
 export(is_splittable)
 export(is_valid_redcap_url)
 export(is_valid_token)
-export(label_report)
 export(launch_FreesearchR)
 export(limit_data_size)
 export(limit_log)
@@ -137,7 +134,6 @@ export(remove_empty_attr)
 export(remove_empty_cols)
 export(remove_nested_list)
 export(repeated_instruments)
-export(restore_labels)
 export(sankey_ready)
 export(selectInputIcon)
 export(separate_string)
@@ -171,7 +167,6 @@ export(visual_summary_ui)
 export(wide2long)
 export(winbox_create_column)
 export(winbox_update_factor)
-export(with_labels)
 export(wrap_plot_list)
 export(write_quarto)
 importFrom(classInt,classIntervals)

NEWS.md

@@ -1,15 +1,3 @@
-# FreesearchR 26.3.3
-
-*NEW* option to pass global settings when running as docker or launching from R. Support for INCLUDE_GLOBALENV, DATA_LIMIT_DEFAULT, DATA_LIMIT_UPPER and DATA_LIMIT_LOWER. Docs are missing...
-
-# FreesearchR 26.3.2
-
-*FIX* Updating factor levels always created new factor.
-
-*FIX* Label stripping behavior updating factors is fixed.
-
-*NEW* New with_labels() function (and helpers) added to allow easy preservation of labels.
-
 # FreesearchR 26.3.1
 
 *FIX* ~~Include font files for static loading without dependency on Google.~~ Kept webfonts from google as local fonts are not working for now.

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'26.3.2'
+app_version <- function()'26.3.1'

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v26.3.2-260311'
+hosted_version <- function()'v26.3.1-260302'

R/launch_FreesearchR.R

@@ -23,11 +23,11 @@ launch_FreesearchR <- function(inlcude_globalenv = TRUE,
                                data_limit_upper = 100000,
                                data_limit_lower = 1,
                                ...) {
-  Sys.setenv(
+  global_freesearchR <- list(
-    INCLUDE_GLOBALENV = include_globalenv,
+    include_globalenv = include_globalenv,
-    DATA_LIMIT_DEFAULT = data_limit_default,
+    data_limit_default = data_limit_default,
-    DATA_LIMIT_UPPER = data_limit_upper,
+    data_limit_upper = data_limit_upper,
-    DATA_LIMIT_LOWER = data_limit_lower
+    data_limit_lower = data_limit_lower
   )
 
   appDir <- system.file("apps", "FreesearchR", package = "FreesearchR")
@@ -39,21 +39,3 @@ launch_FreesearchR <- function(inlcude_globalenv = TRUE,
   a <- shiny::runApp(appDir = paste0(appDir, "/app.R"), ...)
   return(invisible(a))
 }
-
-
-## Helper to set env variables
-get_config <- function(var_name, default = NULL) {
-  # First check environment variables (set by Docker)
-  val <- Sys.getenv(var_name, unset = NA)
-
-  if (!is.na(val) && nzchar(val)) {
-    return(val)
-  }
-
-  # Fall back to default (can be overridden when launching from R)
-  if (!is.null(default)) {
-    return(default)
-  }
-
-  stop(paste("Required config variable not set:", var_name))
-}

R/missings-module.R

@@ -351,17 +351,29 @@ compare_missings <- function(data,
 #' ##   missings_logic_across() |>
 #' ##   gtsummary::tbl_summary()
 missings_logic_across <- function(data, exclude = NULL) {
-  # This function includes a way to preserve variable labels
+  # This function includes a approach way to preserve variable labels
-  with_labels(data,{
   names(data) |>
     lapply(\(.x) {
+      # browser()
+      # Saving original labels
+      lab <- REDCapCAST::get_attr(data[[.x]], attr = "label")
       if (!.x %in% exclude) {
-        is.na(data[[.x]])
+        out <- is.na(data[[.x]])
       } else {
-        data[[.x]]
+        out <- data[[.x]]
+      }
+      if (!is.na(lab)) {
+        # Restoring original labels, if not NA
+        REDCapCAST::set_attr(
+          data = out,
+          label = lab,
+          attr = "label",
+          overwrite = TRUE
+        )
+      } else {
+        out
       }
     }) |>
     dplyr::bind_cols(.name_repair = "unique_quiet") |>
     setNames(names(data))
-  })
 }

R/ui_elements.R

@@ -83,9 +83,9 @@ ui_elements <- function(selection) {
               layout_params = "dropdown",
               # title = "Choose a datafile to upload",
               file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta"),
-              limit_default = DATA_LIMIT_DEFAULT,
+              limit_default = global_freesearchR$data_limit_default,
-              limit_lower = DATA_LIMIT_LOWER,
+              limit_lower = global_freesearchR$data_limit_lower,
-              limit_upper = DATA_LIMIT_UPPER
+              limit_upper = global_freesearchR$data_limit_upper
 
             )
           ),
@@ -107,7 +107,7 @@ ui_elements <- function(selection) {
               id = "env",
               title = NULL,
               packages = c("NHANES", "stRoke", "datasets", "MASS"),
-              globalenv = isTruthy(INCLUDE_GLOBALENV)
+              globalenv = global_freesearchR$include_globalenv
             )
           ),
           # shiny::conditionalPanel(

R/update-factor-ext.R

@@ -70,7 +70,7 @@ 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 the one selected)"),
         value = FALSE,
         status = "primary",
         outline = TRUE,
@@ -201,18 +201,15 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
       parameters <- list(
         variable = variable,
         new_variable = isTRUE(input$new_var) |
-          any(grid[["Var1_toset"]] != "New label"),
+          any(grid[["Var1_toset"]] == "New label"),
         new_levels = as.character(grid[["Var1"]]),
         new_labels = as.character(grid[["Var1_toset"]]),
         ignore = "New label"
       )
 
       data <- tryCatch({
-        with_labels(data,{
         rlang::exec(factor_new_levels_labels,
                     !!!modifyList(parameters, val = list(data = data)))
-        })
-
       }, error = function(err) {
         showNotification(paste(
           "We encountered the following error creating the new factor:",

R/utils-labels.R

@@ -1,114 +0,0 @@
-# =============================================================================
-# Column Label Utilities
-#
-# Coded with help from Claude to save time.
-# Could be seperated for its own package.
-# =============================================================================
-
-#' Extract column labels from a data frame
-#'
-#' @param df A data frame.
-#' @return A named character vector of label strings (only labelled columns included).
-#' @export
-extract_labels <- function(df) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-
-  labels <- vapply(df, function(col) {
-    lbl <- attr(col, "label")
-    if (is.null(lbl)) NA_character_ else as.character(lbl)
-  }, FUN.VALUE = character(1))
-
-  labels[!is.na(labels)]
-}
-
-
-#' Apply a named label vector to a data frame
-#'
-#' @param df A data frame.
-#' @param labels A named character vector (names = column names, values = labels).
-#'   Typically the output of [extract_labels()]. Labels for absent columns are
-#'   silently ignored.
-#' @return `df` with `"label"` attributes set on matching columns.
-#' @export
-apply_labels <- function(df, labels) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-  if (!is.character(labels) || is.null(names(labels))) {
-    stop("`labels` must be a named character vector.", call. = FALSE)
-  }
-
-  for (col in intersect(names(labels), names(df))) {
-    attr(df[[col]], "label") <- labels[[col]]
-  }
-
-  df
-}
-
-
-#' Restore column labels using a reference data frame
-#'
-#' Convenience wrapper around [extract_labels()] + [apply_labels()]. Labels are
-#' matched by column name; new columns in `df_modified` are left unchanged.
-#'
-#' @param df_modified A data frame whose columns should receive labels.
-#' @param df_reference A data frame carrying the authoritative `"label"` attributes.
-#' @return `df_modified` with labels restored on all columns present in `df_reference`.
-#' @export
-restore_labels <- function(df_modified, df_reference) {
-  if (!is.data.frame(df_modified))  stop("`df_modified` must be a data frame.",  call. = FALSE)
-  if (!is.data.frame(df_reference)) stop("`df_reference` must be a data frame.", call. = FALSE)
-
-  apply_labels(df_modified, extract_labels(df_reference))
-}
-
-
-#' Evaluate an expression while preserving column labels
-#'
-#' Snapshots labels from `df` before evaluating `expr`, then reapplies them to
-#' matching columns in the result. New columns created inside `expr` receive no
-#' label automatically.
-#'
-#' @param df A data frame carrying `"label"` attributes.
-#' @param expr An unquoted expression that transforms `df` and returns a data frame.
-#' @return The data frame produced by `expr`, with original labels restored.
-#' @export
-with_labels <- function(df, expr) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-
-  labels <- extract_labels(df)
-  result <- eval(substitute(expr), parent.frame())
-
-  if (!is.data.frame(result)) {
-    stop("The expression passed to `with_labels()` must return a data frame.", call. = FALSE)
-  }
-
-  apply_labels(result, labels)
-}
-
-
-#' Print a tidy summary of column labels
-#'
-#' @param df A data frame.
-#' @param missing_marker String used when a column has no label. Default: `"(no label)"`.
-#' @return A `column / class / label` data frame, printed and returned invisibly.
-#' @export
-label_report <- function(df, missing_marker = "(no label)") {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-  if (!is.character(missing_marker) || length(missing_marker) != 1L) {
-    stop("`missing_marker` must be a single character string.", call. = FALSE)
-  }
-
-  labels <- vapply(df, function(col) {
-    lbl <- attr(col, "label")
-    if (is.null(lbl)) missing_marker else as.character(lbl)
-  }, FUN.VALUE = character(1))
-
-  report <- data.frame(
-    column = names(df),
-    class  = vapply(df, function(x) paste(class(x), collapse = "/"), character(1)),
-    label  = unname(labels),
-    stringsAsFactors = FALSE
-  )
-
-  print(report, row.names = FALSE)
-  invisible(report)
-}

SESSION.md

@@ -11,11 +11,11 @@
 |collate     |en_US.UTF-8                                |
 |ctype       |en_US.UTF-8                                |
 |tz          |Europe/Copenhagen                          |
-|date        |2026-03-11                                 |
+|date        |2026-03-02                                 |
 |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.2.260311                              |
+|FreesearchR |26.3.1.260302                              |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -44,6 +44,7 @@
 |cardx             |0.3.2         |2026-02-05 |CRAN (R 4.5.2) |
 |caTools           |1.18.3        |2024-09-04 |CRAN (R 4.5.0) |
 |cellranger        |1.1.0         |2016-07-27 |CRAN (R 4.5.0) |
+|cffr              |1.2.1         |2026-01-12 |CRAN (R 4.5.2) |
 |checkmate         |2.3.4         |2026-02-03 |CRAN (R 4.5.2) |
 |class             |7.3-23        |2025-01-01 |CRAN (R 4.5.2) |
 |classInt          |0.4-11        |2025-01-08 |CRAN (R 4.5.0) |
@@ -53,6 +54,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 +85,7 @@
 |foreach           |1.5.2         |2022-02-02 |CRAN (R 4.5.0) |
 |foreign           |0.8-90        |2025-03-31 |CRAN (R 4.5.2) |
 |Formula           |1.2-5         |2023-02-24 |CRAN (R 4.5.0) |
-|FreesearchR       |26.3.2        |NA         |NA             |
+|FreesearchR       |26.3.1        |NA         |NA             |
 |fs                |1.6.6         |2025-04-12 |CRAN (R 4.5.0) |
 |gdtools           |0.5.0         |2026-02-09 |CRAN (R 4.5.2) |
 |generics          |0.1.4         |2025-05-09 |CRAN (R 4.5.0) |
@@ -111,6 +113,7 @@
 |iterators         |1.0.14        |2022-02-05 |CRAN (R 4.5.0) |
 |jquerylib         |0.1.4         |2021-04-26 |CRAN (R 4.5.0) |
 |jsonlite          |2.0.0         |2025-03-27 |CRAN (R 4.5.0) |
+|jsonvalidate      |1.5.0         |2025-02-07 |CRAN (R 4.5.0) |
 |KernSmooth        |2.23-26       |2025-01-01 |CRAN (R 4.5.2) |
 |keyring           |1.4.1         |2025-06-15 |CRAN (R 4.5.0) |
 |knitr             |1.51          |2025-12-20 |CRAN (R 4.5.2) |
@@ -158,6 +161,7 @@
 |R6                |2.6.1         |2025-02-15 |CRAN (R 4.5.0) |
 |ragg              |1.5.0         |2025-09-02 |CRAN (R 4.5.0) |
 |rankinPlot        |1.1.0         |2023-01-30 |CRAN (R 4.5.0) |
+|rappdirs          |0.3.4         |2026-01-17 |CRAN (R 4.5.2) |
 |rbibutils         |2.4.1         |2026-01-21 |CRAN (R 4.5.2) |
 |RColorBrewer      |1.1-3         |2022-04-03 |CRAN (R 4.5.0) |
 |Rcpp              |1.1.1         |2026-01-10 |CRAN (R 4.5.2) |
@@ -212,6 +216,7 @@
 |tzdb              |0.5.0         |2025-03-15 |CRAN (R 4.5.0) |
 |usethis           |3.2.1         |2025-09-06 |CRAN (R 4.5.0) |
 |uuid              |1.2-2         |2026-01-23 |CRAN (R 4.5.2) |
+|V8                |8.0.1         |2025-10-10 |CRAN (R 4.5.0) |
 |vctrs             |0.7.1         |2026-01-23 |CRAN (R 4.5.2) |
 |viridis           |0.6.5         |2024-01-29 |CRAN (R 4.5.0) |
 |viridisLite       |0.4.3         |2026-02-04 |CRAN (R 4.5.2) |

app_docker/app.R

@@ -1,7 +1,7 @@
 
 
 ########
-#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpsadCw0/file14b247eddca29.R 
+#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpxB1KWR/file173c96fd4c8c9.R 
 ########
 
 i18n_path <- here::here("translations")
@@ -75,7 +75,7 @@ if (!"global_freesearchR" %in% ls(name = globalenv())) {
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'26.3.2'
+app_version <- function()'26.3.1'
 
 
 ########
@@ -4527,7 +4527,7 @@ data_types <- function() {
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v26.3.2-260311'
+hosted_version <- function()'v26.3.1-260302'
 
 
 ########
@@ -6367,19 +6367,31 @@ compare_missings <- function(data,
 #' ##   missings_logic_across() |>
 #' ##   gtsummary::tbl_summary()
 missings_logic_across <- function(data, exclude = NULL) {
-  # This function includes a way to preserve variable labels
+  # This function includes a approach way to preserve variable labels
-  with_labels(data,{
   names(data) |>
     lapply(\(.x) {
+      # browser()
+      # Saving original labels
+      lab <- REDCapCAST::get_attr(data[[.x]], attr = "label")
       if (!.x %in% exclude) {
-        is.na(data[[.x]])
+        out <- is.na(data[[.x]])
       } else {
-        data[[.x]]
+        out <- data[[.x]]
+      }
+      if (!is.na(lab)) {
+        # Restoring original labels, if not NA
+        REDCapCAST::set_attr(
+          data = out,
+          label = lab,
+          attr = "label",
+          overwrite = TRUE
+        )
+      } else {
+        out
       }
     }) |>
     dplyr::bind_cols(.name_repair = "unique_quiet") |>
     setNames(names(data))
-  })
 }
 
 
@@ -11423,7 +11435,7 @@ 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 the one selected)"),
         value = FALSE,
         status = "primary",
         outline = TRUE,
@@ -11554,18 +11566,15 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
       parameters <- list(
         variable = variable,
         new_variable = isTRUE(input$new_var) |
-          any(grid[["Var1_toset"]] != "New label"),
+          any(grid[["Var1_toset"]] == "New label"),
         new_levels = as.character(grid[["Var1"]]),
         new_labels = as.character(grid[["Var1_toset"]]),
         ignore = "New label"
       )
 
       data <- tryCatch({
-        with_labels(data,{
         rlang::exec(factor_new_levels_labels,
                     !!!modifyList(parameters, val = list(data = data)))
-        })
-
       }, error = function(err) {
         showNotification(paste(
           "We encountered the following error creating the new factor:",
@@ -12537,126 +12546,6 @@ clean_date <- function(data) {
 #
 
 
-########
-#### Current file: /Users/au301842/FreesearchR/R//utils-labels.R 
-########
-
-# =============================================================================
-# Column Label Utilities
-#
-# Coded with help from Claude to save time.
-# Could be seperated for its own package.
-# =============================================================================
-
-#' Extract column labels from a data frame
-#'
-#' @param df A data frame.
-#' @return A named character vector of label strings (only labelled columns included).
-#' @export
-extract_labels <- function(df) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-
-  labels <- vapply(df, function(col) {
-    lbl <- attr(col, "label")
-    if (is.null(lbl)) NA_character_ else as.character(lbl)
-  }, FUN.VALUE = character(1))
-
-  labels[!is.na(labels)]
-}
-
-
-#' Apply a named label vector to a data frame
-#'
-#' @param df A data frame.
-#' @param labels A named character vector (names = column names, values = labels).
-#'   Typically the output of [extract_labels()]. Labels for absent columns are
-#'   silently ignored.
-#' @return `df` with `"label"` attributes set on matching columns.
-#' @export
-apply_labels <- function(df, labels) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-  if (!is.character(labels) || is.null(names(labels))) {
-    stop("`labels` must be a named character vector.", call. = FALSE)
-  }
-
-  for (col in intersect(names(labels), names(df))) {
-    attr(df[[col]], "label") <- labels[[col]]
-  }
-
-  df
-}
-
-
-#' Restore column labels using a reference data frame
-#'
-#' Convenience wrapper around [extract_labels()] + [apply_labels()]. Labels are
-#' matched by column name; new columns in `df_modified` are left unchanged.
-#'
-#' @param df_modified A data frame whose columns should receive labels.
-#' @param df_reference A data frame carrying the authoritative `"label"` attributes.
-#' @return `df_modified` with labels restored on all columns present in `df_reference`.
-#' @export
-restore_labels <- function(df_modified, df_reference) {
-  if (!is.data.frame(df_modified))  stop("`df_modified` must be a data frame.",  call. = FALSE)
-  if (!is.data.frame(df_reference)) stop("`df_reference` must be a data frame.", call. = FALSE)
-
-  apply_labels(df_modified, extract_labels(df_reference))
-}
-
-
-#' Evaluate an expression while preserving column labels
-#'
-#' Snapshots labels from `df` before evaluating `expr`, then reapplies them to
-#' matching columns in the result. New columns created inside `expr` receive no
-#' label automatically.
-#'
-#' @param df A data frame carrying `"label"` attributes.
-#' @param expr An unquoted expression that transforms `df` and returns a data frame.
-#' @return The data frame produced by `expr`, with original labels restored.
-#' @export
-with_labels <- function(df, expr) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-
-  labels <- extract_labels(df)
-  result <- eval(substitute(expr), parent.frame())
-
-  if (!is.data.frame(result)) {
-    stop("The expression passed to `with_labels()` must return a data frame.", call. = FALSE)
-  }
-
-  apply_labels(result, labels)
-}
-
-
-#' Print a tidy summary of column labels
-#'
-#' @param df A data frame.
-#' @param missing_marker String used when a column has no label. Default: `"(no label)"`.
-#' @return A `column / class / label` data frame, printed and returned invisibly.
-#' @export
-label_report <- function(df, missing_marker = "(no label)") {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-  if (!is.character(missing_marker) || length(missing_marker) != 1L) {
-    stop("`missing_marker` must be a single character string.", call. = FALSE)
-  }
-
-  labels <- vapply(df, function(col) {
-    lbl <- attr(col, "label")
-    if (is.null(lbl)) missing_marker else as.character(lbl)
-  }, FUN.VALUE = character(1))
-
-  report <- data.frame(
-    column = names(df),
-    class  = vapply(df, function(x) paste(class(x), collapse = "/"), character(1)),
-    label  = unname(labels),
-    stringsAsFactors = FALSE
-  )
-
-  print(report, row.names = FALSE)
-  invisible(report)
-}
-
-
 ########
 #### Current file: /Users/au301842/FreesearchR/R//validation.R 
 ########

app_docker/translations/translation_da.csv

@@ -61,6 +61,7 @@
 "Factor variable to reorder:","Kategoriske variabel der skal ændres:"
 "Sort by levels","Sorter efter niveauer"
 "Sort by count","Sorter efter antal"
+"Create a new variable (otherwise replaces the one selected)","Opret en ny variabel (ellers erstattes den oprindelige)"
 "Update factor variable","Updater faktor-variabel"
 "Levels","Niveauer"
 "Count","Antal"
@@ -327,4 +328,3 @@
 "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."
 "Sample data","Træningsdata"
-"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)"

app_docker/translations/translation_sw.csv

@@ -61,6 +61,7 @@
 "Factor variable to reorder:","Kigezo cha vipengele ili kupanga upya:"
 "Sort by levels","Panga kwa viwango"
 "Sort by count","Panga kwa hesabu"
+"Create a new variable (otherwise replaces the one selected)","Unda kigezo kipya (vinginevyo kinachukua nafasi ya kile kilichochaguliwa)"
 "Update factor variable","Sasisha kigezo cha kipengele"
 "Levels","Viwango"
 "Count","Hesabu"
@@ -327,4 +328,3 @@
 "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."
 "Sample data","Sample 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)"

inst/apps/FreesearchR/app.R

@@ -1,7 +1,7 @@
 
 
 ########
-#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpxB1KWR/file173c978fea931.R 
+#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpxB1KWR/file173c92887da27.R 
 ########
 
 i18n_path <- system.file("translations", package = "FreesearchR")
@@ -75,7 +75,7 @@ if (!"global_freesearchR" %in% ls(name = globalenv())) {
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'26.3.2'
+app_version <- function()'26.3.1'
 
 
 ########
@@ -4527,7 +4527,7 @@ data_types <- function() {
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v26.3.2-260311'
+hosted_version <- function()'v26.3.1-260302'
 
 
 ########
@@ -6367,19 +6367,31 @@ compare_missings <- function(data,
 #' ##   missings_logic_across() |>
 #' ##   gtsummary::tbl_summary()
 missings_logic_across <- function(data, exclude = NULL) {
-  # This function includes a way to preserve variable labels
+  # This function includes a approach way to preserve variable labels
-  with_labels(data,{
   names(data) |>
     lapply(\(.x) {
+      # browser()
+      # Saving original labels
+      lab <- REDCapCAST::get_attr(data[[.x]], attr = "label")
       if (!.x %in% exclude) {
-        is.na(data[[.x]])
+        out <- is.na(data[[.x]])
       } else {
-        data[[.x]]
+        out <- data[[.x]]
+      }
+      if (!is.na(lab)) {
+        # Restoring original labels, if not NA
+        REDCapCAST::set_attr(
+          data = out,
+          label = lab,
+          attr = "label",
+          overwrite = TRUE
+        )
+      } else {
+        out
       }
     }) |>
     dplyr::bind_cols(.name_repair = "unique_quiet") |>
     setNames(names(data))
-  })
 }
 
 
@@ -11423,7 +11435,7 @@ 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 the one selected)"),
         value = FALSE,
         status = "primary",
         outline = TRUE,
@@ -11554,18 +11566,15 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
       parameters <- list(
         variable = variable,
         new_variable = isTRUE(input$new_var) |
-          any(grid[["Var1_toset"]] != "New label"),
+          any(grid[["Var1_toset"]] == "New label"),
         new_levels = as.character(grid[["Var1"]]),
         new_labels = as.character(grid[["Var1_toset"]]),
         ignore = "New label"
       )
 
       data <- tryCatch({
-        with_labels(data,{
         rlang::exec(factor_new_levels_labels,
                     !!!modifyList(parameters, val = list(data = data)))
-        })
-
       }, error = function(err) {
         showNotification(paste(
           "We encountered the following error creating the new factor:",
@@ -12537,126 +12546,6 @@ clean_date <- function(data) {
 #
 
 
-########
-#### Current file: /Users/au301842/FreesearchR/R//utils-labels.R 
-########
-
-# =============================================================================
-# Column Label Utilities
-#
-# Coded with help from Claude to save time.
-# Could be seperated for its own package.
-# =============================================================================
-
-#' Extract column labels from a data frame
-#'
-#' @param df A data frame.
-#' @return A named character vector of label strings (only labelled columns included).
-#' @export
-extract_labels <- function(df) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-
-  labels <- vapply(df, function(col) {
-    lbl <- attr(col, "label")
-    if (is.null(lbl)) NA_character_ else as.character(lbl)
-  }, FUN.VALUE = character(1))
-
-  labels[!is.na(labels)]
-}
-
-
-#' Apply a named label vector to a data frame
-#'
-#' @param df A data frame.
-#' @param labels A named character vector (names = column names, values = labels).
-#'   Typically the output of [extract_labels()]. Labels for absent columns are
-#'   silently ignored.
-#' @return `df` with `"label"` attributes set on matching columns.
-#' @export
-apply_labels <- function(df, labels) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-  if (!is.character(labels) || is.null(names(labels))) {
-    stop("`labels` must be a named character vector.", call. = FALSE)
-  }
-
-  for (col in intersect(names(labels), names(df))) {
-    attr(df[[col]], "label") <- labels[[col]]
-  }
-
-  df
-}
-
-
-#' Restore column labels using a reference data frame
-#'
-#' Convenience wrapper around [extract_labels()] + [apply_labels()]. Labels are
-#' matched by column name; new columns in `df_modified` are left unchanged.
-#'
-#' @param df_modified A data frame whose columns should receive labels.
-#' @param df_reference A data frame carrying the authoritative `"label"` attributes.
-#' @return `df_modified` with labels restored on all columns present in `df_reference`.
-#' @export
-restore_labels <- function(df_modified, df_reference) {
-  if (!is.data.frame(df_modified))  stop("`df_modified` must be a data frame.",  call. = FALSE)
-  if (!is.data.frame(df_reference)) stop("`df_reference` must be a data frame.", call. = FALSE)
-
-  apply_labels(df_modified, extract_labels(df_reference))
-}
-
-
-#' Evaluate an expression while preserving column labels
-#'
-#' Snapshots labels from `df` before evaluating `expr`, then reapplies them to
-#' matching columns in the result. New columns created inside `expr` receive no
-#' label automatically.
-#'
-#' @param df A data frame carrying `"label"` attributes.
-#' @param expr An unquoted expression that transforms `df` and returns a data frame.
-#' @return The data frame produced by `expr`, with original labels restored.
-#' @export
-with_labels <- function(df, expr) {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-
-  labels <- extract_labels(df)
-  result <- eval(substitute(expr), parent.frame())
-
-  if (!is.data.frame(result)) {
-    stop("The expression passed to `with_labels()` must return a data frame.", call. = FALSE)
-  }
-
-  apply_labels(result, labels)
-}
-
-
-#' Print a tidy summary of column labels
-#'
-#' @param df A data frame.
-#' @param missing_marker String used when a column has no label. Default: `"(no label)"`.
-#' @return A `column / class / label` data frame, printed and returned invisibly.
-#' @export
-label_report <- function(df, missing_marker = "(no label)") {
-  if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE)
-  if (!is.character(missing_marker) || length(missing_marker) != 1L) {
-    stop("`missing_marker` must be a single character string.", call. = FALSE)
-  }
-
-  labels <- vapply(df, function(col) {
-    lbl <- attr(col, "label")
-    if (is.null(lbl)) missing_marker else as.character(lbl)
-  }, FUN.VALUE = character(1))
-
-  report <- data.frame(
-    column = names(df),
-    class  = vapply(df, function(x) paste(class(x), collapse = "/"), character(1)),
-    label  = unname(labels),
-    stringsAsFactors = FALSE
-  )
-
-  print(report, row.names = FALSE)
-  invisible(report)
-}
-
-
 ########
 #### Current file: /Users/au301842/FreesearchR/R//validation.R 
 ########

inst/translations/translation_da.csv

@@ -61,6 +61,7 @@
 "Factor variable to reorder:","Kategoriske variabel der skal ændres:"
 "Sort by levels","Sorter efter niveauer"
 "Sort by count","Sorter efter antal"
+"Create a new variable (otherwise replaces the one selected)","Opret en ny variabel (ellers erstattes den oprindelige)"
 "Update factor variable","Updater faktor-variabel"
 "Levels","Niveauer"
 "Count","Antal"
@@ -327,4 +328,3 @@
 "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."
 "Sample data","Træningsdata"
-"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)"

inst/translations/translation_sw.csv

@@ -61,6 +61,7 @@
 "Factor variable to reorder:","Kigezo cha vipengele ili kupanga upya:"
 "Sort by levels","Panga kwa viwango"
 "Sort by count","Panga kwa hesabu"
+"Create a new variable (otherwise replaces the one selected)","Unda kigezo kipya (vinginevyo kinachukua nafasi ya kile kilichochaguliwa)"
 "Update factor variable","Sasisha kigezo cha kipengele"
 "Levels","Viwango"
 "Count","Hesabu"
@@ -327,4 +328,3 @@
 "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."
 "Sample data","Sample 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)"

man/apply_labels.Rd

@@ -1,21 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils-labels.R
-\name{apply_labels}
-\alias{apply_labels}
-\title{Apply a named label vector to a data frame}
-\usage{
-apply_labels(df, labels)
-}
-\arguments{
-\item{df}{A data frame.}
-
-\item{labels}{A named character vector (names = column names, values = labels).
-Typically the output of \code{\link[=extract_labels]{extract_labels()}}. Labels for absent columns are
-silently ignored.}
-}
-\value{
-\code{df} with \code{"label"} attributes set on matching columns.
-}
-\description{
-Apply a named label vector to a data frame
-}

man/extract_labels.Rd

@@ -1,17 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils-labels.R
-\name{extract_labels}
-\alias{extract_labels}
-\title{Extract column labels from a data frame}
-\usage{
-extract_labels(df)
-}
-\arguments{
-\item{df}{A data frame.}
-}
-\value{
-A named character vector of label strings (only labelled columns included).
-}
-\description{
-Extract column labels from a data frame
-}

man/label_report.Rd

@@ -1,19 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils-labels.R
-\name{label_report}
-\alias{label_report}
-\title{Print a tidy summary of column labels}
-\usage{
-label_report(df, missing_marker = "(no label)")
-}
-\arguments{
-\item{df}{A data frame.}
-
-\item{missing_marker}{String used when a column has no label. Default: \code{"(no label)"}.}
-}
-\value{
-A \code{column / class / label} data frame, printed and returned invisibly.
-}
-\description{
-Print a tidy summary of column labels
-}

man/restore_labels.Rd

@@ -1,20 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils-labels.R
-\name{restore_labels}
-\alias{restore_labels}
-\title{Restore column labels using a reference data frame}
-\usage{
-restore_labels(df_modified, df_reference)
-}
-\arguments{
-\item{df_modified}{A data frame whose columns should receive labels.}
-
-\item{df_reference}{A data frame carrying the authoritative \code{"label"} attributes.}
-}
-\value{
-\code{df_modified} with labels restored on all columns present in \code{df_reference}.
-}
-\description{
-Convenience wrapper around \code{\link[=extract_labels]{extract_labels()}} + \code{\link[=apply_labels]{apply_labels()}}. Labels are
-matched by column name; new columns in \code{df_modified} are left unchanged.
-}

man/with_labels.Rd

@@ -1,21 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils-labels.R
-\name{with_labels}
-\alias{with_labels}
-\title{Evaluate an expression while preserving column labels}
-\usage{
-with_labels(df, expr)
-}
-\arguments{
-\item{df}{A data frame carrying \code{"label"} attributes.}
-
-\item{expr}{An unquoted expression that transforms \code{df} and returns a data frame.}
-}
-\value{
-The data frame produced by \code{expr}, with original labels restored.
-}
-\description{
-Snapshots labels from \code{df} before evaluating \code{expr}, then reapplies them to
-matching columns in the result. New columns created inside \code{expr} receive no
-label automatically.
-}

tests/testthat/test-utils-labels.R

@@ -1,143 +0,0 @@
-# Tests for column label utilities (extract_labels, apply_labels,
-# restore_labels, with_labels, label_report)
-
-# --- extract_labels ----------------------------------------------------------
-
-test_that("extract_labels returns named character vector of present labels", {
-  df <- data.frame(a = 1:3, b = 4:6, c = 7:9)
-  attr(df$a, "label") <- "Column A"
-  attr(df$b, "label") <- "Column B"
-
-  lbls <- extract_labels(df)
-
-  expect_type(lbls, "character")
-  expect_named(lbls, c("a", "b"))
-  expect_equal(lbls[["a"]], "Column A")
-  expect_equal(lbls[["b"]], "Column B")
-  expect_false("c" %in% names(lbls))
-})
-
-test_that("extract_labels returns zero-length vector when no labels present", {
-  expect_equal(length(extract_labels(data.frame(x = 1, y = 2))), 0L)
-})
-
-test_that("extract_labels errors on non-data-frame input", {
-  expect_error(extract_labels(list(a = 1)), "`df` must be a data frame")
-  expect_error(extract_labels(1:5),         "`df` must be a data frame")
-})
-
-
-# --- apply_labels ------------------------------------------------------------
-
-test_that("apply_labels sets label attributes on matching columns", {
-  df  <- data.frame(age = 1:3, income = c(10, 20, 30))
-  df2 <- apply_labels(df, c(age = "Age (years)", income = "Income (USD)"))
-
-  expect_equal(attr(df2$age,    "label"), "Age (years)")
-  expect_equal(attr(df2$income, "label"), "Income (USD)")
-})
-
-test_that("apply_labels silently ignores labels for absent columns", {
-  df <- data.frame(age = 1:3)
-  expect_no_error(apply_labels(df, c(age = "Age", income = "Income")))
-  expect_equal(attr(apply_labels(df, c(age = "Age", income = "Income"))$age, "label"), "Age")
-})
-
-test_that("apply_labels errors on bad inputs", {
-  expect_error(apply_labels(list(),       c(a = "A")), "`df` must be a data frame")
-  expect_error(apply_labels(data.frame(), c("A")),     "`labels` must be a named")
-  expect_error(apply_labels(data.frame(), 123),        "`labels` must be a named")
-})
-
-
-# --- restore_labels ----------------------------------------------------------
-
-test_that("restore_labels copies labels from reference to modified df", {
-  df <- data.frame(a = 1:5, b = letters[1:5], stringsAsFactors = FALSE)
-  attr(df$a, "label") <- "Variable A"
-  attr(df$b, "label") <- "Variable B"
-
-  df_mod <- df[df$a > 2, ]
-  attr(df_mod$a, "label") <- NULL
-  attr(df_mod$b, "label") <- NULL
-
-  df_restored <- restore_labels(df_mod, df)
-
-  expect_equal(attr(df_restored$a, "label"), "Variable A")
-  expect_equal(attr(df_restored$b, "label"), "Variable B")
-})
-
-test_that("restore_labels does not error when modified df has extra columns", {
-  df <- data.frame(x = 1:3)
-  attr(df$x, "label") <- "X"
-
-  df_mod <- df
-  df_mod$y <- df$x * 2
-
-  result <- restore_labels(df_mod, df)
-  expect_equal(attr(result$x, "label"), "X")
-  expect_null(attr(result$y, "label"))
-})
-
-test_that("restore_labels errors on non-data-frame inputs", {
-  df <- data.frame(x = 1)
-  expect_error(restore_labels(list(), df), "`df_modified` must be a data frame")
-  expect_error(restore_labels(df, list()), "`df_reference` must be a data frame")
-})
-
-
-# --- with_labels -------------------------------------------------------------
-
-test_that("with_labels preserves labels through a subsetting expression", {
-  df <- data.frame(id = 1:5, age = c(25, 34, 45, 29, 52))
-  attr(df$age, "label") <- "Age (years)"
-
-  result <- with_labels(df, df[df$age > 30, ])
-  expect_equal(attr(result$age, "label"), "Age (years)")
-})
-
-test_that("with_labels does not assign labels to new columns", {
-  df <- data.frame(x = 1:3, y = 4:6)
-  attr(df$x, "label") <- "X label"
-
-  result <- with_labels(df, { df$z <- df$x + df$y; df })
-
-  expect_equal(attr(result$x, "label"), "X label")
-  expect_null(attr(result$z, "label"))
-})
-
-test_that("with_labels errors when expression does not return a data frame", {
-  df <- data.frame(x = 1:3)
-  expect_error(with_labels(df, sum(df$x)), "must return a data frame")
-})
-
-test_that("with_labels errors on non-data-frame df argument", {
-  expect_error(with_labels(list(x = 1), list()), "`df` must be a data frame")
-})
-
-
-# --- label_report ------------------------------------------------------------
-
-test_that("label_report returns correct structure", {
-  df <- data.frame(a = 1L, b = "x", stringsAsFactors = FALSE)
-  attr(df$a, "label") <- "Alpha"
-
-  report <- label_report(df)
-
-  expect_s3_class(report, "data.frame")
-  expect_named(report, c("column", "class", "label"))
-  expect_equal(nrow(report), 2L)
-  expect_equal(report$label[report$column == "a"], "Alpha")
-  expect_equal(report$label[report$column == "b"], "(no label)")
-})
-
-test_that("label_report respects custom missing_marker", {
-  df     <- data.frame(x = 1)
-  report <- label_report(df, missing_marker = "N/A")
-  expect_equal(report$label[1], "N/A")
-})
-
-test_that("label_report errors on bad inputs", {
-  expect_error(label_report(list()),               "`df` must be a data frame")
-  expect_error(label_report(data.frame(), c("a", "b")), "`missing_marker`")
-})