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: 25.12.1
+version: 25.11.1
 doi: 10.5281/zenodo.14527429
 identifiers:
 - type: url
@@ -1063,40 +1063,6 @@ references:
     orcid: https://orcid.org/0000-0002-7559-1154
   year: '2025'
   doi: 10.32614/CRAN.package.stRoke
-- type: software
-  title: data.table
-  abstract: 'data.table: Extension of `data.frame`'
-  notes: Imports
-  url: https://r-datatable.com
-  repository: https://CRAN.R-project.org/package=data.table
-  authors:
-  - family-names: Barrett
-    given-names: Tyson
-    email: t.barrett88@gmail.com
-    orcid: https://orcid.org/0000-0002-2137-1391
-  - family-names: Dowle
-    given-names: Matt
-    email: mattjdowle@gmail.com
-  - family-names: Srinivasan
-    given-names: Arun
-    email: asrini@pm.me
-  - family-names: Gorecki
-    given-names: Jan
-  - family-names: Chirico
-    given-names: Michael
-    orcid: https://orcid.org/0000-0003-0787-087X
-  - family-names: Hocking
-    given-names: Toby
-    orcid: https://orcid.org/0000-0002-3146-0865
-  - family-names: Schwendinger
-    given-names: Benjamin
-    orcid: https://orcid.org/0000-0003-3315-8114
-  - family-names: Krylov
-    given-names: Ivan
-    email: ikrylov@disroot.org
-    orcid: https://orcid.org/0000-0002-0172-3812
-  year: '2025'
-  doi: 10.32614/CRAN.package.data.table
 - type: software
   title: styler
   abstract: 'styler: Non-Invasive Pretty Printing of R Code'

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FreesearchR
 Title: Easy data analysis for clinicians
-Version: 25.12.1
+Version: 25.11.2
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154")),

NAMESPACE

@@ -51,7 +51,6 @@ export(default_parsing)
 export(detect_delimiter)
 export(drop_empty_event)
 export(expression_string)
-export(factor_new_levels_labels)
 export(factorize)
 export(file_export)
 export(format_writer)
@@ -149,7 +148,6 @@ export(symmetrical_scale_x_log10)
 export(tbl_merge)
 export(type_icons)
 export(ui_elements)
-export(unique_names)
 export(unique_short)
 export(update_factor_server)
 export(update_factor_ui)

NEWS.md

@@ -1,11 +1,3 @@
-# FreesearchR 25.12.1
-
-*NEW* Option to edit factor label names in the "New factor" pop-up. This allows for easier naming for tables, but also to combine levels. A new variable is appended to the dataset if label names are changed. Code is now also exported.
-
-*FIX* Fixes a bug, where white space in code exported was removed. Now a little too many spaces are included. Fine tuning continues.
-
-*NEW* Easily copy code by just clicking "copy" in code blocks.
-
 # FreesearchR 25.11.2
 
 *NEW* Vignettes were moved to the [FreesearchR project knowledge base](https://freesearchr.github.io/FreesearchR-knowledge/). This was mainly to ease rendering and allow quick and easy updates as well as future translations.

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'25.12.1'
+app_version <- function()'25.11.2'

R/cut-variable-ext.R

@@ -374,11 +374,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           }
         )
 
-        data <- append_column(data,
+        data <- append_column(data, column = new_variable, name = paste0(variable, "_cut"), index = "right")
-                              column = new_variable,
-                              name = unique_names(paste0(variable, "_cut"),
-                                                  existing = names(data)),
-                              index = "right")
 
         code <- rlang::call2(
           "append_column",

R/helpers.R

@@ -515,82 +515,18 @@ pipe_string <- function(data, collapse = "|>\n") {
 #' @examples
 #' list(
 #'   as.symbol(paste0("mtcars$", "mpg")),
-#'   rlang::call2(.fn = "select", !!!list(c("cyl", "di  sp")), .ns = "dplyr"),
+#'   rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
 #'   rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
 #' ) |>
 #'   merge_expression() |>
 #'   expression_string()
 expression_string <- function(data, assign.str = "") {
   exp.str <- if (is.call(data)) deparse(data) else data
-
+  # browser()
   out <- paste0(assign.str, gsub("%>%", "|>\n", paste(gsub('"', "'", paste(exp.str, collapse = "")), collapse = "")))
-  out <- collapse_spaces(out,preserve_newlines = FALSE)
+  gsub(" |`", "", out)
-  gsub("`", "", out)
 }
 
-#' Substitue spaces/tabs with single space excluding text within quotes
-#'
-#' @description
-#' Written assisted by Claude.ai. It is long and possibly too complicated,
-#' but it works
-#'
-#'
-#' @param x character string
-#' @param preserve_newlines flag to preserve new lines
-#'
-#' @returns character string
-#'
-#' @examples
-#' collapse_spaces(c("cyl", "di sp","s e   d","d  e'dl  e'"))
-collapse_spaces <- function(x, preserve_newlines = TRUE) {
-  # Function to process a single string
-  process_string <- function(text) {
-    # Pattern to match single-quoted strings
-    quote_pattern <- "'[^']*'"
-
-    # Find all quoted strings and their positions
-    quotes <- gregexpr(quote_pattern, text, perl = TRUE)[[1]]
-
-    if (quotes[1] == -1) {
-      # No quoted strings, process entire text
-      if (preserve_newlines) {
-        return(gsub("[ \\t]{1,}", " ", text))
-      } else {
-        return(gsub("\\s{1,}", " ", text))
-      }
-    }
-
-    # Extract quoted strings
-    quote_lengths <- attr(quotes, "match.length")
-    quoted_parts <- substring(text, quotes, quotes + quote_lengths - 1)
-
-    # Create placeholders
-    placeholders <- paste0("__QUOTE_", seq_along(quoted_parts), "__")
-
-    # Replace quoted strings with placeholders
-    result <- text
-    for (i in seq_along(quoted_parts)) {
-      result <- sub(quote_pattern, placeholders[i], result, perl = TRUE)
-    }
-
-    # Collapse spaces in non-quoted parts
-    if (preserve_newlines) {
-      result <- gsub("[ \\t]{2,}", "", result)
-    } else {
-      result <- gsub("\\s{2,}", "", result)
-    }
-
-    # Restore quoted strings
-    for (i in seq_along(quoted_parts)) {
-      result <- sub(placeholders[i], quoted_parts[i], result, fixed = TRUE)
-    }
-
-    return(result)
-  }
-
-  # Apply to each element of vector
-  sapply(x, process_string, USE.NAMES = FALSE)
-}
 
 #' Very simple function to remove nested lists, like when uploading .rds
 #'

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v25.12.1-251202'
+hosted_version <- function()'v25.11.2-251119'

R/syntax_highlight.R

@@ -11,25 +11,15 @@ prismCodeBlock <- function(code) {
 
 prismDependencies <- tags$head(
   tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/prism.min.js"),
-  tags$link(
+  tags$link(rel = "stylesheet", type = "text/css",
-    rel = "stylesheet", type = "text/css",
+            href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css")
-    href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css"
-  ),
-  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js"),
-  tags$link(
-    rel = "stylesheet",
-    href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.css"
-  ),
-  tags$script(
-    src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.js"
-  ),
-  tags$script(
-    src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/copy-to-clipboard/prism-copy-to-clipboard.min.js"
-  )
 )
 
+prismRDependency <- tags$head(
+  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js")
+)
 
-html_code_wrap <- function(string, lang = "r") {
+html_code_wrap <- function(string,lang="r"){
   glue::glue("<pre><code class='language-{lang}'>{string}
   </code></pre>")
 }

R/update-factor-ext.R

@@ -1,3 +1,4 @@
+
 ## Works, but not implemented
 ##
 ## These edits mainly allows for
@@ -100,6 +101,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
   moduleServer(
     id,
     function(input, output, session) {
+
       rv <- reactiveValues(data = NULL, data_grid = NULL)
 
       bindEvent(observe({
@@ -205,37 +207,19 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
         data <- req(data_r())
         variable <- req(input$variable)
         grid <- req(input$grid_data)
-
+        name_var <- if (isTRUE(input$new_var)) {
-        parameters <- list(
+          paste0(variable, "_updated")
-          variable = variable,
+        } else {
-          new_variable = isTRUE(input$new_var) | any(grid[["Var1_toset"]] == "New label"),
+          variable
-          new_levels = as.character(grid[["Var1"]]),
+        }
-          new_labels = as.character(grid[["Var1_toset"]]),
+        data[[name_var]] <- factor(
-          ignore = "New label"
+          as.character(data[[variable]]),
+          levels = grid[["Var1"]]
         )
-
+        data[[name_var]] <- factor(
-        data <- tryCatch(
+          data[[variable]],
-          {
+          labels = ifelse(grid[["Var1_toset"]]=="New label",grid[["Var1"]],grid[["Var1_toset"]])
-            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:", err), type = "err")
-          }
         )
-
-        # browser()
-        code <- rlang::call2(
-          "factor_new_levels_labels",
-          !!!parameters,
-          .ns = "FreesearchR"
-        )
-        attr(data, "code") <- code
-
         data
       })
 
@@ -247,62 +231,6 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
   )
 }
 
-#' Simple function to apply new levels and/or labels to factor
-#'
-#' @param variable factor variable
-#' @param new_level new levels, same length as original
-#' @param new_label new labels, same length as original
-#' @param ignore character string to ignore in new labels
-#'
-#' @returns factor
-#' @export
-#'
-#' @examples
-#' data_n <- mtcars
-#' data_n$cyl <- factor(data_n$cyl)
-#' factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label"))
-factor_new_levels_labels <- function(
-    data,
-    variable,
-    new_variable = TRUE,
-    new_levels = NULL,
-    new_labels = NULL,
-    ignore = "New label") {
-  if (!is.factor(data[[variable]])) {
-    return(data)
-  }
-
-  if (is.null(new_levels)) {
-    new_levels <- levels(data[[variable]])
-  }
-
-  if (is.null(new_labels)) {
-    new_labels <- labels(data[[variable]])
-  }
-
-  with_level <- factor(
-    as.character(data[[variable]]),
-    levels = new_levels
-  )
-  with_label <- factor(
-    with_level,
-    labels = ifelse(new_labels == "New label", new_levels, new_labels)
-  )
-
-  # browser()
-
-  if (isTRUE(new_variable)) {
-    append_column(
-      data = data,
-      column = with_label,
-      name = unique_names(new = paste0(variable, "_updated"), existing = names(data))
-    )
-  } else {
-    data[[variable]] <- new_variable
-    data
-  }
-}
-
 
 
 #' @inheritParams shiny::modalDialog
@@ -361,22 +289,3 @@ winbox_update_factor <- function(id,
   )
 }
 
-
-#' Make unique variable names
-#'
-#' Helper function to create new variable names that are unique
-#' given a set of existing names (in a data set, for example).
-#' If a variable name already exists, a number will be appended.
-#'
-#' @param new a vector of proposed new variable names
-#' @param existing a vector of existing variable names
-#' @return a vector of unique new variable names
-#' @examples
-#' unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z"))
-#'
-#' @export
-unique_names <- function(new, existing = character()) {
-  new_names <- make.unique(c(existing, new), sep = "_")
-
-  new_names[-seq_along(existing)]
-}

SESSION.md

@@ -1,21 +1,21 @@
 --------------------------------------------------------------------------------
 -------------------------------- R environment ---------------------------------
 --------------------------------------------------------------------------------
-|setting     |value                                          |
+|setting     |value                                      |
-|:-----------|:----------------------------------------------|
+|:-----------|:------------------------------------------|
-|version     |R version 4.4.1 (2024-06-14)                   |
+|version     |R version 4.4.1 (2024-06-14)               |
-|os          |macOS 26.1                                     |
+|os          |macOS 15.7.1                               |
-|system      |aarch64, darwin20                              |
+|system      |aarch64, darwin20                          |
-|ui          |RStudio                                        |
+|ui          |RStudio                                    |
-|language    |(EN)                                           |
+|language    |(EN)                                       |
-|collate     |en_US.UTF-8                                    |
+|collate     |en_US.UTF-8                                |
-|ctype       |en_US.UTF-8                                    |
+|ctype       |en_US.UTF-8                                |
-|tz          |Europe/Copenhagen                              |
+|tz          |Europe/Copenhagen                          |
-|date        |2025-12-02                                     |
+|date        |2025-11-09                                 |
-|rstudio     |2025.09.2+418 Cucumberleaf Sunflower (desktop) |
+|rstudio     |2025.05.0+496 Mariposa Orchid (desktop)    |
-|pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown)     |
+|pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
-|quarto      |1.7.30 @ /usr/local/bin/quarto                 |
+|quarto      |1.7.30 @ /usr/local/bin/quarto             |
-|FreesearchR |25.12.1.251202                                 |
+|FreesearchR |25.11.1.251109                             |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -83,7 +83,7 @@
 |foreach           |1.5.2         |2022-02-02 |CRAN (R 4.4.0) |
 |foreign           |0.8-90        |2025-03-31 |CRAN (R 4.4.1) |
 |Formula           |1.2-5         |2023-02-24 |CRAN (R 4.4.1) |
-|FreesearchR       |25.12.1       |NA         |NA             |
+|FreesearchR       |25.11.1       |NA         |NA             |
 |fs                |1.6.6         |2025-04-12 |CRAN (R 4.4.1) |
 |gdtools           |0.4.2         |2025-03-27 |CRAN (R 4.4.1) |
 |generics          |0.1.4         |2025-05-09 |CRAN (R 4.4.1) |
@@ -117,9 +117,11 @@
 |later             |1.4.2         |2025-04-08 |RSPM (R 4.4.0) |
 |lattice           |0.22-7        |2025-04-02 |CRAN (R 4.4.1) |
 |lifecycle         |1.0.4         |2023-11-07 |CRAN (R 4.4.1) |
+|litedown          |0.7           |2025-04-08 |CRAN (R 4.4.1) |
 |lme4              |1.1-37        |2025-03-26 |CRAN (R 4.4.1) |
 |lubridate         |1.9.4         |2024-12-08 |CRAN (R 4.4.1) |
 |magrittr          |2.0.3         |2022-03-30 |RSPM (R 4.4.0) |
+|markdown          |2.0           |2025-03-23 |CRAN (R 4.4.1) |
 |MASS              |7.3-65        |2025-02-28 |CRAN (R 4.4.1) |
 |Matrix            |1.7-3         |2025-03-11 |RSPM (R 4.4.0) |
 |memoise           |2.0.1         |2021-11-26 |CRAN (R 4.4.0) |

app_docker/app.R

@@ -1,7 +1,7 @@
 
 
 ########
-#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpyM6210/file126781ad7585e.R 
+#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpFr1XvR/file15f634a33505f.R 
 ########
 
 i18n_path <- here::here("translations")
@@ -62,7 +62,7 @@ i18n$set_translation_language("en")
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'25.12.1'
+app_version <- function()'25.11.1'
 
 
 ########
@@ -1656,11 +1656,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           }
         )
 
-        data <- append_column(data,
+        data <- append_column(data, column = new_variable, name = paste0(variable, "_cut"), index = "right")
-                              column = new_variable,
-                              name = unique_names(paste0(variable, "_cut"),
-                                                  existing = names(data)),
-                              index = "right")
 
         code <- rlang::call2(
           "append_column",
@@ -4064,82 +4060,18 @@ pipe_string <- function(data, collapse = "|>\n") {
 #' @examples
 #' list(
 #'   as.symbol(paste0("mtcars$", "mpg")),
-#'   rlang::call2(.fn = "select", !!!list(c("cyl", "di  sp")), .ns = "dplyr"),
+#'   rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
 #'   rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
 #' ) |>
 #'   merge_expression() |>
 #'   expression_string()
 expression_string <- function(data, assign.str = "") {
   exp.str <- if (is.call(data)) deparse(data) else data
-
+  # browser()
   out <- paste0(assign.str, gsub("%>%", "|>\n", paste(gsub('"', "'", paste(exp.str, collapse = "")), collapse = "")))
-  out <- collapse_spaces(out,preserve_newlines = FALSE)
+  gsub(" |`", "", out)
-  gsub("`", "", out)
 }
 
-#' Substitue spaces/tabs with single space excluding text within quotes
-#'
-#' @description
-#' Written assisted by Claude.ai. It is long and possibly too complicated,
-#' but it works
-#'
-#'
-#' @param x character string
-#' @param preserve_newlines flag to preserve new lines
-#'
-#' @returns character string
-#'
-#' @examples
-#' collapse_spaces(c("cyl", "di sp","s e   d","d  e'dl  e'"))
-collapse_spaces <- function(x, preserve_newlines = TRUE) {
-  # Function to process a single string
-  process_string <- function(text) {
-    # Pattern to match single-quoted strings
-    quote_pattern <- "'[^']*'"
-
-    # Find all quoted strings and their positions
-    quotes <- gregexpr(quote_pattern, text, perl = TRUE)[[1]]
-
-    if (quotes[1] == -1) {
-      # No quoted strings, process entire text
-      if (preserve_newlines) {
-        return(gsub("[ \\t]{1,}", " ", text))
-      } else {
-        return(gsub("\\s{1,}", " ", text))
-      }
-    }
-
-    # Extract quoted strings
-    quote_lengths <- attr(quotes, "match.length")
-    quoted_parts <- substring(text, quotes, quotes + quote_lengths - 1)
-
-    # Create placeholders
-    placeholders <- paste0("__QUOTE_", seq_along(quoted_parts), "__")
-
-    # Replace quoted strings with placeholders
-    result <- text
-    for (i in seq_along(quoted_parts)) {
-      result <- sub(quote_pattern, placeholders[i], result, perl = TRUE)
-    }
-
-    # Collapse spaces in non-quoted parts
-    if (preserve_newlines) {
-      result <- gsub("[ \\t]{2,}", "", result)
-    } else {
-      result <- gsub("\\s{2,}", "", result)
-    }
-
-    # Restore quoted strings
-    for (i in seq_along(quoted_parts)) {
-      result <- sub(placeholders[i], quoted_parts[i], result, fixed = TRUE)
-    }
-
-    return(result)
-  }
-
-  # Apply to each element of vector
-  sapply(x, process_string, USE.NAMES = FALSE)
-}
 
 #' Very simple function to remove nested lists, like when uploading .rds
 #'
@@ -4369,7 +4301,7 @@ data_types <- function() {
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v25.12.1-251202'
+hosted_version <- function()'v25.11.1-251109'
 
 
 ########
@@ -9481,25 +9413,15 @@ prismCodeBlock <- function(code) {
 
 prismDependencies <- tags$head(
   tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/prism.min.js"),
-  tags$link(
+  tags$link(rel = "stylesheet", type = "text/css",
-    rel = "stylesheet", type = "text/css",
+            href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css")
-    href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css"
-  ),
-  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js"),
-  tags$link(
-    rel = "stylesheet",
-    href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.css"
-  ),
-  tags$script(
-    src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.js"
-  ),
-  tags$script(
-    src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/copy-to-clipboard/prism-copy-to-clipboard.min.js"
-  )
 )
 
+prismRDependency <- tags$head(
+  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js")
+)
 
-html_code_wrap <- function(string, lang = "r") {
+html_code_wrap <- function(string,lang="r"){
   glue::glue("<pre><code class='language-{lang}'>{string}
   </code></pre>")
 }
@@ -10300,6 +10222,7 @@ ui_elements <- function(selection) {
 #### Current file: /Users/au301842/FreesearchR/R//update-factor-ext.R 
 ########
 
+
 ## Works, but not implemented
 ##
 ## These edits mainly allows for
@@ -10402,6 +10325,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
   moduleServer(
     id,
     function(input, output, session) {
+
       rv <- reactiveValues(data = NULL, data_grid = NULL)
 
       bindEvent(observe({
@@ -10507,37 +10431,19 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
         data <- req(data_r())
         variable <- req(input$variable)
         grid <- req(input$grid_data)
-
+        name_var <- if (isTRUE(input$new_var)) {
-        parameters <- list(
+          paste0(variable, "_updated")
-          variable = variable,
+        } else {
-          new_variable = isTRUE(input$new_var) | any(grid[["Var1_toset"]] == "New label"),
+          variable
-          new_levels = as.character(grid[["Var1"]]),
+        }
-          new_labels = as.character(grid[["Var1_toset"]]),
+        data[[name_var]] <- factor(
-          ignore = "New label"
+          as.character(data[[variable]]),
+          levels = grid[["Var1"]]
         )
-
+        data[[name_var]] <- factor(
-        data <- tryCatch(
+          data[[variable]],
-          {
+          labels = ifelse(grid[["Var1_toset"]]=="New label",grid[["Var1"]],grid[["Var1_toset"]])
-            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:", err), type = "err")
-          }
         )
-
-        # browser()
-        code <- rlang::call2(
-          "factor_new_levels_labels",
-          !!!parameters,
-          .ns = "FreesearchR"
-        )
-        attr(data, "code") <- code
-
         data
       })
 
@@ -10549,62 +10455,6 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
   )
 }
 
-#' Simple function to apply new levels and/or labels to factor
-#'
-#' @param variable factor variable
-#' @param new_level new levels, same length as original
-#' @param new_label new labels, same length as original
-#' @param ignore character string to ignore in new labels
-#'
-#' @returns factor
-#' @export
-#'
-#' @examples
-#' data_n <- mtcars
-#' data_n$cyl <- factor(data_n$cyl)
-#' factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label"))
-factor_new_levels_labels <- function(
-    data,
-    variable,
-    new_variable = TRUE,
-    new_levels = NULL,
-    new_labels = NULL,
-    ignore = "New label") {
-  if (!is.factor(data[[variable]])) {
-    return(data)
-  }
-
-  if (is.null(new_levels)) {
-    new_levels <- levels(data[[variable]])
-  }
-
-  if (is.null(new_labels)) {
-    new_labels <- labels(data[[variable]])
-  }
-
-  with_level <- factor(
-    as.character(data[[variable]]),
-    levels = new_levels
-  )
-  with_label <- factor(
-    with_level,
-    labels = ifelse(new_labels == "New label", new_levels, new_labels)
-  )
-
-  # browser()
-
-  if (isTRUE(new_variable)) {
-    append_column(
-      data = data,
-      column = with_label,
-      name = unique_names(new = paste0(variable, "_updated"), existing = names(data))
-    )
-  } else {
-    data[[variable]] <- new_variable
-    data
-  }
-}
-
 
 
 #' @inheritParams shiny::modalDialog
@@ -10664,25 +10514,6 @@ winbox_update_factor <- function(id,
 }
 
 
-#' Make unique variable names
-#'
-#' Helper function to create new variable names that are unique
-#' given a set of existing names (in a data set, for example).
-#' If a variable name already exists, a number will be appended.
-#'
-#' @param new a vector of proposed new variable names
-#' @param existing a vector of existing variable names
-#' @return a vector of unique new variable names
-#' @examples
-#' unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z"))
-#'
-#' @export
-unique_names <- function(new, existing = character()) {
-  new_names <- make.unique(c(existing, new), sep = "_")
-
-  new_names[-seq_along(existing)]
-}
-
 
 ########
 #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R 
@@ -11986,6 +11817,7 @@ make_validation_alerts <- function(data) {
 #' @returns Shiny ui module
 #' @export
 #'
+#' @example examples/visual_summary_demo.R
 visual_summary_ui <- function(id) {
   ns <- shiny::NS(id)
 
@@ -12079,6 +11911,14 @@ modal_visual_summary <- function(id,
 #' @returns An [apexchart()] `htmlwidget` object.
 #' @export
 #'
+#' @examples
+#' data_demo <- mtcars
+#' data_demo[2:4, "cyl"] <- NA
+#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
+#' data_demo |> missings_apex_plot()
+#' mtcars |> missings_apex_plot(animation = TRUE)
+#' # dplyr::storms |> missings_apex_plot()
+#' visdat::vis_dat(dplyr::storms)
 missings_apex_plot <- function(data, animation = FALSE, ...) {
   l <- data_summary_gather(data, ...)
 
@@ -12129,6 +11969,14 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
 #' @returns ggplot2 object
 #' @export
 #'
+#' @examples
+#' data_demo <- mtcars
+#' data_demo[sample(1:32, 10), "cyl"] <- NA
+#' data_demo[sample(1:32, 8), "vs"] <- NA
+#' visual_summary(data_demo)
+#' visual_summary(data_demo, palette.fun = scales::hue_pal())
+#' visual_summary(dplyr::storms, summary.fun = data_type)
+#' visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class")
 visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...) {
   l <- data_summary_gather(data, ...)
 
@@ -12180,7 +12028,7 @@ visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...
 #' @export
 #'
 #' @examples
-#' mtcars |> data_summary_gather() |> names()
+#' mtcars |> data_summary_gather()
 data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis, na.label = "NA", ...) {
   df_plot <- setNames(data, unique_short(names(data))) |>
     purrr::map_df(\(x){
@@ -12460,6 +12308,7 @@ ui <- bslib::page_fixed(
   usei18n(i18n),
   ## Code formatting dependencies
   prismDependencies,
+  prismRDependency,
   # html_dependency_FreesearchR(),
   ## Version dependent header
   header_include(),
@@ -12964,12 +12813,10 @@ server <- function(input, output, session) {
 
   shiny::observeEvent(
     input$modal_update,
-    # datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
+    datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
-    modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
   )
 
-  # data_modal_update <- datamods::update_factor_server(
+  data_modal_update <- datamods::update_factor_server(
-  data_modal_update <- update_factor_server(
     id = "modal_update",
     data_r = reactive(rv$data)
   )
@@ -13418,19 +13265,17 @@ server <- function(input, output, session) {
 
 
   output$detail_level <- shiny::renderUI({
-    shiny::radioButtons(
+  shiny::radioButtons(
-      inputId = "detail_level",
+    inputId = "detail_level",
-      label = i18n$t("Level of detail"),
+    label = i18n$t("Level of detail"),
-      selected = "minimal",
+    selected = "minimal",
-      inline = TRUE, choiceValues = c(
+    inline = TRUE,choiceValues = c("minimal",
-        "minimal",
+                                   "extended"),
-        "extended"
+    choiceNames = c(
-      ),
+      i18n$t("Minimal"),
-      choiceNames = c(
+      i18n$t("Extensive")
-        i18n$t("Minimal"),
-        i18n$t("Extensive")
-      )
     )
+  )
   })
 
 

inst/apps/FreesearchR/app.R

@@ -1,7 +1,7 @@
 
 
 ########
-#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpyM6210/file1267841f7ff86.R 
+#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpigVRui/file787d74b713ef.R 
 ########
 
 i18n_path <- system.file("translations", package = "FreesearchR")
@@ -62,7 +62,7 @@ i18n$set_translation_language("en")
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'25.12.1'
+app_version <- function()'25.10.5'
 
 
 ########
@@ -83,6 +83,7 @@ app_version <- function()'25.12.1'
 #' mtcars |> baseline_table()
 #' mtcars |> baseline_table(fun.args = list(by = "gear"))
 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)
 }
@@ -93,26 +94,19 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
 #'
 #' @param data data
 #' @param ... passed as fun.arg to baseline_table()
+#' @param strat.var grouping/strat variable
 #' @param add.p add comparison/p-value
 #' @param add.overall add overall column
-#' @param by.var specify stratification variable
-#' @param theme set table theme
-#' @param detail_level specify detail level. Either "minimal" or "extended".
 #'
 #' @returns gtsummary table list object
 #' @export
 #'
 #' @examples
 #' mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes")
-#' mtcars |> create_baseline(by.var = "gear", detail_level = "extended")
-#' 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.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon"), detail_level = c("minimal", "extended")) {
+create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon")) {
   theme <- match.arg(theme)
 
-  detail_level <- match.arg(detail_level)
-
   if (by.var == "none" | !by.var %in% names(data)) {
     by.var <- NULL
   }
@@ -130,32 +124,11 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS
 
   args <- list(...)
 
-  # browser()
-
-  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}"))
-          )
-        )
-    }
-  }
-
   parameters <- list(
     data = data,
-    fun.args = purrr::list_flatten(list(by = by.var, args))
+    fun.args = list(by = by.var, ...)
   )
 
-
-  # browser()
   out <- do.call(
     baseline_table,
     parameters
@@ -1656,11 +1629,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           }
         )
 
-        data <- append_column(data,
+        data <- append_column(data, column = new_variable, name = paste0(variable, "_cut"), index = "right")
-                              column = new_variable,
-                              name = unique_names(paste0(variable, "_cut"),
-                                                  existing = names(data)),
-                              index = "right")
 
         code <- rlang::call2(
           "append_column",
@@ -4064,82 +4033,18 @@ pipe_string <- function(data, collapse = "|>\n") {
 #' @examples
 #' list(
 #'   as.symbol(paste0("mtcars$", "mpg")),
-#'   rlang::call2(.fn = "select", !!!list(c("cyl", "di  sp")), .ns = "dplyr"),
+#'   rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
 #'   rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
 #' ) |>
 #'   merge_expression() |>
 #'   expression_string()
 expression_string <- function(data, assign.str = "") {
   exp.str <- if (is.call(data)) deparse(data) else data
-
+  # browser()
   out <- paste0(assign.str, gsub("%>%", "|>\n", paste(gsub('"', "'", paste(exp.str, collapse = "")), collapse = "")))
-  out <- collapse_spaces(out,preserve_newlines = FALSE)
+  gsub(" |`", "", out)
-  gsub("`", "", out)
 }
 
-#' Substitue spaces/tabs with single space excluding text within quotes
-#'
-#' @description
-#' Written assisted by Claude.ai. It is long and possibly too complicated,
-#' but it works
-#'
-#'
-#' @param x character string
-#' @param preserve_newlines flag to preserve new lines
-#'
-#' @returns character string
-#'
-#' @examples
-#' collapse_spaces(c("cyl", "di sp","s e   d","d  e'dl  e'"))
-collapse_spaces <- function(x, preserve_newlines = TRUE) {
-  # Function to process a single string
-  process_string <- function(text) {
-    # Pattern to match single-quoted strings
-    quote_pattern <- "'[^']*'"
-
-    # Find all quoted strings and their positions
-    quotes <- gregexpr(quote_pattern, text, perl = TRUE)[[1]]
-
-    if (quotes[1] == -1) {
-      # No quoted strings, process entire text
-      if (preserve_newlines) {
-        return(gsub("[ \\t]{1,}", " ", text))
-      } else {
-        return(gsub("\\s{1,}", " ", text))
-      }
-    }
-
-    # Extract quoted strings
-    quote_lengths <- attr(quotes, "match.length")
-    quoted_parts <- substring(text, quotes, quotes + quote_lengths - 1)
-
-    # Create placeholders
-    placeholders <- paste0("__QUOTE_", seq_along(quoted_parts), "__")
-
-    # Replace quoted strings with placeholders
-    result <- text
-    for (i in seq_along(quoted_parts)) {
-      result <- sub(quote_pattern, placeholders[i], result, perl = TRUE)
-    }
-
-    # Collapse spaces in non-quoted parts
-    if (preserve_newlines) {
-      result <- gsub("[ \\t]{2,}", "", result)
-    } else {
-      result <- gsub("\\s{2,}", "", result)
-    }
-
-    # Restore quoted strings
-    for (i in seq_along(quoted_parts)) {
-      result <- sub(placeholders[i], quoted_parts[i], result, fixed = TRUE)
-    }
-
-    return(result)
-  }
-
-  # Apply to each element of vector
-  sapply(x, process_string, USE.NAMES = FALSE)
-}
 
 #' Very simple function to remove nested lists, like when uploading .rds
 #'
@@ -4369,7 +4274,7 @@ data_types <- function() {
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v25.12.1-251202'
+hosted_version <- function()'v25.10.5-251031'
 
 
 ########
@@ -9481,25 +9386,15 @@ prismCodeBlock <- function(code) {
 
 prismDependencies <- tags$head(
   tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/prism.min.js"),
-  tags$link(
+  tags$link(rel = "stylesheet", type = "text/css",
-    rel = "stylesheet", type = "text/css",
+            href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css")
-    href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css"
-  ),
-  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js"),
-  tags$link(
-    rel = "stylesheet",
-    href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.css"
-  ),
-  tags$script(
-    src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.js"
-  ),
-  tags$script(
-    src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/copy-to-clipboard/prism-copy-to-clipboard.min.js"
-  )
 )
 
+prismRDependency <- tags$head(
+  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js")
+)
 
-html_code_wrap <- function(string, lang = "r") {
+html_code_wrap <- function(string,lang="r"){
   glue::glue("<pre><code class='language-{lang}'>{string}
   </code></pre>")
 }
@@ -10019,17 +9914,6 @@ ui_elements <- function(selection) {
                   value = "acc_pan_chars",
                   title = "Settings",
                   icon = bsicons::bs_icon("table"),
-                  # vectorSelectInput(
-                  #   inputId = "baseline_theme",
-                  #   selected = "none",
-                  #   label = i18n$t("Select table theme"),
-                  #   choices = c(
-                  #     "The Journal of the American Medical Association" = "jama",
-                  #     "The Lancet"="lancet",
-                  #     "The New England Journal of Medicine" = "nejm",
-                  #     "The Quarterly Journal of Economics" = "qjecon")
-                  # ),
-                  shiny::uiOutput("detail_level"),
                   shiny::uiOutput("strat_var"),
                   shiny::helpText(i18n$t("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.")),
                   shiny::conditionalPanel(
@@ -10300,6 +10184,7 @@ ui_elements <- function(selection) {
 #### Current file: /Users/au301842/FreesearchR/R//update-factor-ext.R 
 ########
 
+
 ## Works, but not implemented
 ##
 ## These edits mainly allows for
@@ -10402,6 +10287,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
   moduleServer(
     id,
     function(input, output, session) {
+
       rv <- reactiveValues(data = NULL, data_grid = NULL)
 
       bindEvent(observe({
@@ -10507,37 +10393,19 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
         data <- req(data_r())
         variable <- req(input$variable)
         grid <- req(input$grid_data)
-
+        name_var <- if (isTRUE(input$new_var)) {
-        parameters <- list(
+          paste0(variable, "_updated")
-          variable = variable,
+        } else {
-          new_variable = isTRUE(input$new_var) | any(grid[["Var1_toset"]] == "New label"),
+          variable
-          new_levels = as.character(grid[["Var1"]]),
+        }
-          new_labels = as.character(grid[["Var1_toset"]]),
+        data[[name_var]] <- factor(
-          ignore = "New label"
+          as.character(data[[variable]]),
+          levels = grid[["Var1"]]
         )
-
+        data[[name_var]] <- factor(
-        data <- tryCatch(
+          data[[variable]],
-          {
+          labels = ifelse(grid[["Var1_toset"]]=="New label",grid[["Var1"]],grid[["Var1_toset"]])
-            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:", err), type = "err")
-          }
         )
-
-        # browser()
-        code <- rlang::call2(
-          "factor_new_levels_labels",
-          !!!parameters,
-          .ns = "FreesearchR"
-        )
-        attr(data, "code") <- code
-
         data
       })
 
@@ -10549,62 +10417,6 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
   )
 }
 
-#' Simple function to apply new levels and/or labels to factor
-#'
-#' @param variable factor variable
-#' @param new_level new levels, same length as original
-#' @param new_label new labels, same length as original
-#' @param ignore character string to ignore in new labels
-#'
-#' @returns factor
-#' @export
-#'
-#' @examples
-#' data_n <- mtcars
-#' data_n$cyl <- factor(data_n$cyl)
-#' factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label"))
-factor_new_levels_labels <- function(
-    data,
-    variable,
-    new_variable = TRUE,
-    new_levels = NULL,
-    new_labels = NULL,
-    ignore = "New label") {
-  if (!is.factor(data[[variable]])) {
-    return(data)
-  }
-
-  if (is.null(new_levels)) {
-    new_levels <- levels(data[[variable]])
-  }
-
-  if (is.null(new_labels)) {
-    new_labels <- labels(data[[variable]])
-  }
-
-  with_level <- factor(
-    as.character(data[[variable]]),
-    levels = new_levels
-  )
-  with_label <- factor(
-    with_level,
-    labels = ifelse(new_labels == "New label", new_levels, new_labels)
-  )
-
-  # browser()
-
-  if (isTRUE(new_variable)) {
-    append_column(
-      data = data,
-      column = with_label,
-      name = unique_names(new = paste0(variable, "_updated"), existing = names(data))
-    )
-  } else {
-    data[[variable]] <- new_variable
-    data
-  }
-}
-
 
 
 #' @inheritParams shiny::modalDialog
@@ -10664,25 +10476,6 @@ winbox_update_factor <- function(id,
 }
 
 
-#' Make unique variable names
-#'
-#' Helper function to create new variable names that are unique
-#' given a set of existing names (in a data set, for example).
-#' If a variable name already exists, a number will be appended.
-#'
-#' @param new a vector of proposed new variable names
-#' @param existing a vector of existing variable names
-#' @return a vector of unique new variable names
-#' @examples
-#' unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z"))
-#'
-#' @export
-unique_names <- function(new, existing = character()) {
-  new_names <- make.unique(c(existing, new), sep = "_")
-
-  new_names[-seq_along(existing)]
-}
-
 
 ########
 #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R 
@@ -11986,6 +11779,7 @@ make_validation_alerts <- function(data) {
 #' @returns Shiny ui module
 #' @export
 #'
+#' @example examples/visual_summary_demo.R
 visual_summary_ui <- function(id) {
   ns <- shiny::NS(id)
 
@@ -12079,6 +11873,14 @@ modal_visual_summary <- function(id,
 #' @returns An [apexchart()] `htmlwidget` object.
 #' @export
 #'
+#' @examples
+#' data_demo <- mtcars
+#' data_demo[2:4, "cyl"] <- NA
+#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
+#' data_demo |> missings_apex_plot()
+#' mtcars |> missings_apex_plot(animation = TRUE)
+#' # dplyr::storms |> missings_apex_plot()
+#' visdat::vis_dat(dplyr::storms)
 missings_apex_plot <- function(data, animation = FALSE, ...) {
   l <- data_summary_gather(data, ...)
 
@@ -12129,6 +11931,14 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
 #' @returns ggplot2 object
 #' @export
 #'
+#' @examples
+#' data_demo <- mtcars
+#' data_demo[sample(1:32, 10), "cyl"] <- NA
+#' data_demo[sample(1:32, 8), "vs"] <- NA
+#' visual_summary(data_demo)
+#' visual_summary(data_demo, palette.fun = scales::hue_pal())
+#' visual_summary(dplyr::storms, summary.fun = data_type)
+#' visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class")
 visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...) {
   l <- data_summary_gather(data, ...)
 
@@ -12180,7 +11990,7 @@ visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...
 #' @export
 #'
 #' @examples
-#' mtcars |> data_summary_gather() |> names()
+#' mtcars |> data_summary_gather()
 data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis, na.label = "NA", ...) {
   df_plot <- setNames(data, unique_short(names(data))) |>
     purrr::map_df(\(x){
@@ -12460,6 +12270,7 @@ ui <- bslib::page_fixed(
   usei18n(i18n),
   ## Code formatting dependencies
   prismDependencies,
+  prismRDependency,
   # html_dependency_FreesearchR(),
   ## Version dependent header
   header_include(),
@@ -12964,12 +12775,10 @@ server <- function(input, output, session) {
 
   shiny::observeEvent(
     input$modal_update,
-    # datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
+    datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
-    modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
   )
 
-  # data_modal_update <- datamods::update_factor_server(
+  data_modal_update <- datamods::update_factor_server(
-  data_modal_update <- update_factor_server(
     id = "modal_update",
     data_r = reactive(rv$data)
   )
@@ -13392,7 +13201,7 @@ server <- function(input, output, session) {
     columnSelectInput(
       inputId = "strat_var",
       selected = "none",
-      label = i18n$t("Select variable to stratify baseline"),
+      label = "Select variable to stratify baseline",
       data = shiny::reactive(rv$data_filtered)(),
       col_subset = c(
         "none",
@@ -13401,39 +13210,6 @@ server <- function(input, output, session) {
     )
   })
 
-  # output$baseline_theme <- shiny::renderUI({
-  #   choices <-
-  #
-  #   vectorSelectInput(
-  #     inputId = "baseline_theme",
-  #     selected = "none",
-  #     label = i18n$t("Select table theme"),
-  #     choices = c(
-  #       "The Journal of the American Medical Association" = "jama",
-  #       "The Lancet"="lancet",
-  #       "The New England Journal of Medicine" = "nejm",
-  #       "The Quarterly Journal of Economics" = "qjecon")
-  #   )
-  # })
-
-
-  output$detail_level <- shiny::renderUI({
-    shiny::radioButtons(
-      inputId = "detail_level",
-      label = i18n$t("Level of detail"),
-      selected = "minimal",
-      inline = TRUE, choiceValues = c(
-        "minimal",
-        "extended"
-      ),
-      choiceNames = c(
-        i18n$t("Minimal"),
-        i18n$t("Extensive")
-      )
-    )
-  })
-
-
   ##############################################################################
   #########
   #########  Descriptive evaluations
@@ -13459,39 +13235,30 @@ server <- function(input, output, session) {
   #   })
 
 
-
-
   shiny::observeEvent(
     list(
       input$act_eval
     ),
     {
       shiny::req(input$strat_var)
-      # shiny::req(input$baseline_theme)
-      shiny::req(input$detail_level)
       shiny::req(rv$list$data)
 
-
-
       parameters <- list(
         by.var = input$strat_var,
         add.p = input$add_p == "yes",
-        add.overall = TRUE,
+        add.overall = TRUE
-        # theme = input$baseline_theme,
-        detail_level = input$detail_level
       )
 
       ## Limits maximum number of levels included in baseline table to 20.
       data <- rv$list$data |>
         lapply(\(.x){
           # browser()
-          if (is.factor(.x)) {
+          if (is.factor(.x)){
-            cut_var(.x, breaks = 20, type = "top")
+            cut_var(.x,breaks=20,type="top")
           } else {
             .x
           }
-        }) |>
+        }) |> dplyr::bind_cols()
-        dplyr::bind_cols()
 
       # Attempt to introduce error on analysing too large dataset
       # tryCatch(

man/collapse_spaces.Rd

@@ -1,23 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/helpers.R
-\name{collapse_spaces}
-\alias{collapse_spaces}
-\title{Substitue spaces/tabs with single space excluding text within quotes}
-\usage{
-collapse_spaces(x, preserve_newlines = TRUE)
-}
-\arguments{
-\item{x}{character string}
-
-\item{preserve_newlines}{flag to preserve new lines}
-}
-\value{
-character string
-}
-\description{
-Written assisted by Claude.ai. It is long and possibly too complicated,
-but it works
-}
-\examples{
-collapse_spaces(c("cyl", "di sp","s e   d","d  e'dl  e'"))
-}

man/expression_string.Rd

@@ -18,7 +18,7 @@ Deparses expression as string, substitutes native pipe and adds assign
 \examples{
 list(
   as.symbol(paste0("mtcars$", "mpg")),
-  rlang::call2(.fn = "select", !!!list(c("cyl", "di  sp")), .ns = "dplyr"),
+  rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
   rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
 ) |>
   merge_expression() |>

man/factor_new_levels_labels.Rd

@@ -1,35 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/update-factor-ext.R
-\name{factor_new_levels_labels}
-\alias{factor_new_levels_labels}
-\title{Simple function to apply new levels and/or labels to factor}
-\usage{
-factor_new_levels_labels(
-  data,
-  variable,
-  new_variable = TRUE,
-  new_levels = NULL,
-  new_labels = NULL,
-  ignore = "New label"
-)
-}
-\arguments{
-\item{variable}{factor variable}
-
-\item{ignore}{character string to ignore in new labels}
-
-\item{new_level}{new levels, same length as original}
-
-\item{new_label}{new labels, same length as original}
-}
-\value{
-factor
-}
-\description{
-Simple function to apply new levels and/or labels to factor
-}
-\examples{
-data_n <- mtcars
-data_n$cyl <- factor(data_n$cyl)
-factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label"))
-}

man/unique_names.Rd

@@ -1,25 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/update-factor-ext.R
-\name{unique_names}
-\alias{unique_names}
-\title{Make unique variable names}
-\usage{
-unique_names(new, existing = character())
-}
-\arguments{
-\item{new}{a vector of proposed new variable names}
-
-\item{existing}{a vector of existing variable names}
-}
-\value{
-a vector of unique new variable names
-}
-\description{
-Helper function to create new variable names that are unique
-given a set of existing names (in a data set, for example).
-If a variable name already exists, a number will be appended.
-}
-\examples{
-unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z"))
-
-}