fix: modal ui hanging, rerender

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.12.2
 doi: 10.5281/zenodo.14527429
 identifiers:
 - type: url

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FreesearchR
 Title: Easy data analysis for clinicians
-Version: 25.12.1
+Version: 25.12.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

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(cut_var,character)
 S3method(cut_var,default)
 S3method(cut_var,factor)
 S3method(cut_var,hms)

NEWS.md

@@ -1,3 +1,9 @@
+# FreesearchR 25.12.2
+
+*FIX* Fixed hanging interface when splitting strings.
+
+*NEW* New option to shorten character variables to the first N words or characters. Shortening by characters could be useful working with eg. ICD-10 diagnostic codes.
+
 # 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.

R/app_version.R

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

R/cut-variable-ext.R

@@ -40,7 +40,7 @@ cut_variable_ui <- function(id) {
       column(
         width = 3,
         shiny::conditionalPanel(
-          condition = "input.method != 'top' && input.method != 'bottom'",
+          condition = "input.method != 'top' && input.method != 'bottom' && input.method != 'words' && input.method != 'characters'",
           ns = ns,
           checkboxInput(
             inputId = ns("right"),
@@ -94,7 +94,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
         data <- data_r()
         rv$data <- data
         vars_num <- vapply(data, \(.x){
-          is.numeric(.x) || is_datetime(.x) || (is.factor(.x) && length(levels(.x)) > 2)
+          is.numeric(.x) || is_datetime(.x) || (is.factor(.x) && length(levels(.x)) > 2) || is.character(.x)
         }, logical(1))
         vars_num <- names(vars_num)[vars_num]
 
@@ -216,6 +216,12 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
             "top",
             "bottom"
           )
+        } else if ("character" %in% class(data[[variable]])) {
+          choices <- c(
+            choices,
+            "characters",
+            "words"
+          )
         } else {
           choices <- c(
             choices,
@@ -294,7 +300,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           list(var = f, brks = levels(f))
         } else if (input$method %in% c(
           "top",
-          "bottom"
+          "bottom",
+          "characters",
+          "words"
         )) {
           # This allows factor simplification to get the top or bottom count
           f <- cut_var(data[[variable]], breaks = input$n_breaks)
@@ -409,7 +417,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           responseName = "count"
         )
         count_data$freq <- paste(signif(count_data$count / nrow(data) * 100, 3), "%")
-        # browser()
         gridTheme <- getOption("datagrid.theme")
         if (length(gridTheme) < 1) {
           datamods:::apply_grid_theme()
@@ -476,6 +483,9 @@ plot_histogram <- function(data, column = NULL, bins = 30, breaks = NULL, color
   } else {
     x <- data[[column]]
   }
+  if (is.character(x)){
+    x <- REDCapCAST::as_factor(x)
+  }
   x <- as.numeric(x)
   op <- par(mar = rep(1.5, 4))
   on.exit(par(op))
@@ -551,6 +561,18 @@ cut_methods <- function() {
       min = 1,
       max = 50
     ),
+    "characters" = list(
+      descr = i18n$t("Shorten to first letters"),
+      breaks = i18n$t("Letters"),
+      min = 1,
+      max = 20
+    ),
+    "words" = list(
+      descr = i18n$t("Shorten to first words"),
+      breaks = i18n$t("Words"),
+      min = 1,
+      max = 50
+    ),
     "fixed" = list(
       descr = i18n$t("By specified numbers"),
       breaks = i18n$t("Breaks"),

R/cut_var.R

@@ -184,21 +184,24 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other =
   tbl <- sort(table(x), decreasing = TRUE)
 
   if (type == "top") {
-    if (length(levels(x)) <= breaks){
+    if (length(levels(x)) <= breaks) {
       return(x)
     }
     lvls <- names(tbl[seq_len(breaks)])
   } else if (type == "bottom") {
     freqs_check <- tbl / NROW(x) * 100 < breaks
-    if (!any(freqs_check)){
+    if (!any(freqs_check)) {
       return(x)
     }
     lvls <- names(tbl)[!freqs_check]
   }
 
-  if (other %in% lvls) {
+  # if (other %in% lvls) {
-    other <- paste(other, "_freesearchr")
+  #   other <- paste(other, "_freesearchr")
-  }
+  # }
+
+  # Ensure unique new level name
+  other <- unique_names(other, lvls)
 
   ## Relabel and relevel
   out <- forcats::fct_relabel(
@@ -214,6 +217,41 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other =
 }
 
 
+#' Subset first part of string to factor
+#'
+#' @name cut_var
+#'
+#' @returns factor
+#' @export
+#'
+#' @examples
+#' c("Sunday", "This week is short") |> cut_var(breaks = 3)
+cut_var.character <- function(x, breaks = NULL, type = c("characters", "words"), ...) {
+  args <- list(...)
+
+  if (is.null(breaks)) {
+    return(x)
+  }
+
+  type <- match.arg(type)
+
+  if (type == "characters") {
+    out <- substr(x, start = 1, stop = breaks)
+  } else if (type == "words") {
+    out <- strsplit(x, " ") |>
+      sapply(\(.x){
+        if (length(.x) > breaks) {
+          paste(.x[seq_len(breaks)], collapse = " ")
+        } else {
+          paste(.x, collapse = " ")
+        }
+      })
+  }
+
+  attr(out, which = "brks") <- breaks
+  REDCapCAST::as_factor(out)
+}
+
 #' Test class
 #'
 #' @param data data

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v25.12.1-251202'
+hosted_version <- function()'v25.12.2-251203'

SESSION.md

@@ -11,11 +11,11 @@
 |collate     |en_US.UTF-8                                    |
 |ctype       |en_US.UTF-8                                    |
 |tz          |Europe/Copenhagen                              |
-|date        |2025-12-02                                     |
+|date        |2025-12-03                                     |
 |rstudio     |2025.09.2+418 Cucumberleaf Sunflower (desktop) |
 |pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown)     |
 |quarto      |1.7.30 @ /usr/local/bin/quarto                 |
-|FreesearchR |25.12.1.251202                                 |
+|FreesearchR |25.12.2.251203                                 |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -44,6 +44,7 @@
 |cardx             |0.2.5         |2025-07-03 |CRAN (R 4.4.1) |
 |caTools           |1.18.3        |2024-09-04 |CRAN (R 4.4.1) |
 |cellranger        |1.1.0         |2016-07-27 |CRAN (R 4.4.0) |
+|cffr              |1.2.0         |2025-01-25 |CRAN (R 4.4.1) |
 |checkmate         |2.3.2         |2024-07-29 |RSPM (R 4.4.0) |
 |class             |7.3-23        |2025-01-01 |CRAN (R 4.4.1) |
 |classInt          |0.4-11        |2025-01-08 |CRAN (R 4.4.1) |
@@ -53,6 +54,7 @@
 |colorspace        |2.1-1         |2024-07-26 |CRAN (R 4.4.1) |
 |commonmark        |2.0.0         |2025-07-07 |CRAN (R 4.4.1) |
 |crayon            |1.5.3         |2024-06-20 |CRAN (R 4.4.1) |
+|curl              |6.4.0         |2025-06-22 |RSPM (R 4.4.0) |
 |data.table        |1.17.8        |2025-07-10 |CRAN (R 4.4.1) |
 |datamods          |1.5.3         |2024-10-02 |CRAN (R 4.4.1) |
 |datawizard        |1.2.0         |2025-07-17 |CRAN (R 4.4.1) |
@@ -83,7 +85,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.12.2       |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) |
@@ -111,9 +113,11 @@
 |iterators         |1.0.14        |2022-02-05 |CRAN (R 4.4.1) |
 |jquerylib         |0.1.4         |2021-04-26 |CRAN (R 4.4.0) |
 |jsonlite          |2.0.0         |2025-03-27 |CRAN (R 4.4.1) |
+|jsonvalidate      |1.5.0         |2025-02-07 |CRAN (R 4.4.1) |
 |KernSmooth        |2.23-26       |2025-01-01 |CRAN (R 4.4.1) |
 |keyring           |1.4.1         |2025-06-15 |CRAN (R 4.4.1) |
 |knitr             |1.50          |2025-03-16 |CRAN (R 4.4.1) |
+|labeling          |0.4.3         |2023-08-29 |CRAN (R 4.4.1) |
 |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) |
@@ -156,9 +160,14 @@
 |qqconf            |1.3.2         |2023-04-14 |CRAN (R 4.4.0) |
 |qqplotr           |0.0.6         |2023-01-25 |CRAN (R 4.4.0) |
 |quarto            |1.5.0         |2025-07-28 |RSPM (R 4.4.0) |
+|R.cache           |0.17.0        |2025-05-02 |CRAN (R 4.4.1) |
+|R.methodsS3       |1.8.2         |2022-06-13 |CRAN (R 4.4.1) |
+|R.oo              |1.27.1        |2025-05-02 |CRAN (R 4.4.1) |
+|R.utils           |2.13.0        |2025-02-24 |CRAN (R 4.4.1) |
 |R6                |2.6.1         |2025-02-15 |CRAN (R 4.4.1) |
 |ragg              |1.4.0         |2025-04-10 |RSPM (R 4.4.0) |
 |rankinPlot        |1.1.0         |2023-01-30 |CRAN (R 4.4.0) |
+|rappdirs          |0.3.3         |2021-01-31 |CRAN (R 4.4.1) |
 |rbibutils         |2.3           |2024-10-04 |CRAN (R 4.4.1) |
 |RColorBrewer      |1.1-3         |2022-04-03 |CRAN (R 4.4.1) |
 |Rcpp              |1.1.0         |2025-07-02 |CRAN (R 4.4.1) |
@@ -197,6 +206,7 @@
 |stringi           |1.8.7         |2025-03-27 |CRAN (R 4.4.1) |
 |stringr           |1.5.1         |2023-11-14 |RSPM (R 4.4.0) |
 |stRoke            |25.9.2        |2025-09-30 |CRAN (R 4.4.1) |
+|styler            |1.10.3        |2024-04-07 |CRAN (R 4.4.0) |
 |systemfonts       |1.2.3         |2025-04-30 |CRAN (R 4.4.1) |
 |testthat          |3.2.3         |2025-01-13 |CRAN (R 4.4.1) |
 |textshaping       |1.0.1         |2025-05-01 |RSPM (R 4.4.0) |
@@ -211,7 +221,9 @@
 |tzdb              |0.5.0         |2025-03-15 |CRAN (R 4.4.1) |
 |urlchecker        |1.0.1         |2021-11-30 |CRAN (R 4.4.1) |
 |usethis           |3.1.0         |2024-11-26 |RSPM (R 4.4.0) |
+|utf8              |1.2.6         |2025-06-08 |CRAN (R 4.4.1) |
 |uuid              |1.2-1         |2024-07-29 |CRAN (R 4.4.1) |
+|V8                |6.0.6         |2025-08-18 |CRAN (R 4.4.1) |
 |vctrs             |0.6.5         |2023-12-01 |CRAN (R 4.4.0) |
 |vroom             |1.6.5         |2023-12-05 |CRAN (R 4.4.0) |
 |withr             |3.0.2         |2024-10-28 |CRAN (R 4.4.1) |

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//RtmpejDCIE/filec7542b7ed14.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.12.2'
 
 
 ########
@@ -1214,21 +1214,24 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other =
   tbl <- sort(table(x), decreasing = TRUE)
 
   if (type == "top") {
-    if (length(levels(x)) <= breaks){
+    if (length(levels(x)) <= breaks) {
       return(x)
     }
     lvls <- names(tbl[seq_len(breaks)])
   } else if (type == "bottom") {
     freqs_check <- tbl / NROW(x) * 100 < breaks
-    if (!any(freqs_check)){
+    if (!any(freqs_check)) {
       return(x)
     }
     lvls <- names(tbl)[!freqs_check]
   }
 
-  if (other %in% lvls) {
+  # if (other %in% lvls) {
-    other <- paste(other, "_freesearchr")
+  #   other <- paste(other, "_freesearchr")
-  }
+  # }
+
+  # Ensure unique new level name
+  other <- unique_names(other, lvls)
 
   ## Relabel and relevel
   out <- forcats::fct_relabel(
@@ -1244,6 +1247,41 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other =
 }
 
 
+#' Subset first part of string to factor
+#'
+#' @name cut_var
+#'
+#' @returns factor
+#' @export
+#'
+#' @examples
+#' c("Sunday", "This week is short") |> cut_var(breaks = 3)
+cut_var.character <- function(x, breaks = NULL, type = c("characters", "words"), ...) {
+  args <- list(...)
+
+  if (is.null(breaks)) {
+    return(x)
+  }
+
+  type <- match.arg(type)
+
+  if (type == "characters") {
+    out <- substr(x, start = 1, stop = breaks)
+  } else if (type == "words") {
+    out <- strsplit(x, " ") |>
+      sapply(\(.x){
+        if (length(.x) > breaks) {
+          paste(.x[seq_len(breaks)], collapse = " ")
+        } else {
+          paste(.x, collapse = " ")
+        }
+      })
+  }
+
+  attr(out, which = "brks") <- breaks
+  REDCapCAST::as_factor(out)
+}
+
 #' Test class
 #'
 #' @param data data
@@ -1322,7 +1360,7 @@ cut_variable_ui <- function(id) {
       column(
         width = 3,
         shiny::conditionalPanel(
-          condition = "input.method != 'top' && input.method != 'bottom'",
+          condition = "input.method != 'top' && input.method != 'bottom' && input.method != 'words' && input.method != 'characters'",
           ns = ns,
           checkboxInput(
             inputId = ns("right"),
@@ -1376,7 +1414,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
         data <- data_r()
         rv$data <- data
         vars_num <- vapply(data, \(.x){
-          is.numeric(.x) || is_datetime(.x) || (is.factor(.x) && length(levels(.x)) > 2)
+          is.numeric(.x) || is_datetime(.x) || (is.factor(.x) && length(levels(.x)) > 2) || is.character(.x)
         }, logical(1))
         vars_num <- names(vars_num)[vars_num]
 
@@ -1498,6 +1536,12 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
             "top",
             "bottom"
           )
+        } else if ("character" %in% class(data[[variable]])) {
+          choices <- c(
+            choices,
+            "characters",
+            "words"
+          )
         } else {
           choices <- c(
             choices,
@@ -1576,7 +1620,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           list(var = f, brks = levels(f))
         } else if (input$method %in% c(
           "top",
-          "bottom"
+          "bottom",
+          "characters",
+          "words"
         )) {
           # This allows factor simplification to get the top or bottom count
           f <- cut_var(data[[variable]], breaks = input$n_breaks)
@@ -1691,7 +1737,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           responseName = "count"
         )
         count_data$freq <- paste(signif(count_data$count / nrow(data) * 100, 3), "%")
-        # browser()
         gridTheme <- getOption("datagrid.theme")
         if (length(gridTheme) < 1) {
           datamods:::apply_grid_theme()
@@ -1758,6 +1803,9 @@ plot_histogram <- function(data, column = NULL, bins = 30, breaks = NULL, color
   } else {
     x <- data[[column]]
   }
+  if (is.character(x)){
+    x <- REDCapCAST::as_factor(x)
+  }
   x <- as.numeric(x)
   op <- par(mar = rep(1.5, 4))
   on.exit(par(op))
@@ -1833,6 +1881,18 @@ cut_methods <- function() {
       min = 1,
       max = 50
     ),
+    "characters" = list(
+      descr = i18n$t("Shorten to first letters"),
+      breaks = i18n$t("Letters"),
+      min = 1,
+      max = 20
+    ),
+    "words" = list(
+      descr = i18n$t("Shorten to first words"),
+      breaks = i18n$t("Words"),
+      min = 1,
+      max = 50
+    ),
     "fixed" = list(
       descr = i18n$t("By specified numbers"),
       breaks = i18n$t("Breaks"),
@@ -4369,7 +4429,7 @@ data_types <- function() {
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v25.12.1-251202'
+hosted_version <- function()'v25.12.2-251203'
 
 
 ########
@@ -12974,11 +13034,14 @@ server <- function(input, output, session) {
     data_r = reactive(rv$data)
   )
 
-  shiny::observeEvent(data_modal_update(), {
+  shiny::observeEvent(
+    data_modal_update(),
+    {
       shiny::removeModal()
       rv$data <- data_modal_update()
       rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
-  })
+    }
+  )
 
   #########  Split string
 
@@ -12998,6 +13061,7 @@ server <- function(input, output, session) {
   shiny::observeEvent(
     data_modal_string(),
     {
+      shiny::removeModal()
       rv$data <- data_modal_string()
       rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
     }

app_docker/translations/translation_da.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

app_docker/translations/translation_de.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

app_docker/translations/translation_sv.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

app_docker/translations/translation_sw.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

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//RtmpejDCIE/filec7541d50b50.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.12.2'
 
 
 ########
@@ -1214,21 +1214,24 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other =
   tbl <- sort(table(x), decreasing = TRUE)
 
   if (type == "top") {
-    if (length(levels(x)) <= breaks){
+    if (length(levels(x)) <= breaks) {
       return(x)
     }
     lvls <- names(tbl[seq_len(breaks)])
   } else if (type == "bottom") {
     freqs_check <- tbl / NROW(x) * 100 < breaks
-    if (!any(freqs_check)){
+    if (!any(freqs_check)) {
       return(x)
     }
     lvls <- names(tbl)[!freqs_check]
   }
 
-  if (other %in% lvls) {
+  # if (other %in% lvls) {
-    other <- paste(other, "_freesearchr")
+  #   other <- paste(other, "_freesearchr")
-  }
+  # }
+
+  # Ensure unique new level name
+  other <- unique_names(other, lvls)
 
   ## Relabel and relevel
   out <- forcats::fct_relabel(
@@ -1244,6 +1247,41 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other =
 }
 
 
+#' Subset first part of string to factor
+#'
+#' @name cut_var
+#'
+#' @returns factor
+#' @export
+#'
+#' @examples
+#' c("Sunday", "This week is short") |> cut_var(breaks = 3)
+cut_var.character <- function(x, breaks = NULL, type = c("characters", "words"), ...) {
+  args <- list(...)
+
+  if (is.null(breaks)) {
+    return(x)
+  }
+
+  type <- match.arg(type)
+
+  if (type == "characters") {
+    out <- substr(x, start = 1, stop = breaks)
+  } else if (type == "words") {
+    out <- strsplit(x, " ") |>
+      sapply(\(.x){
+        if (length(.x) > breaks) {
+          paste(.x[seq_len(breaks)], collapse = " ")
+        } else {
+          paste(.x, collapse = " ")
+        }
+      })
+  }
+
+  attr(out, which = "brks") <- breaks
+  REDCapCAST::as_factor(out)
+}
+
 #' Test class
 #'
 #' @param data data
@@ -1322,7 +1360,7 @@ cut_variable_ui <- function(id) {
       column(
         width = 3,
         shiny::conditionalPanel(
-          condition = "input.method != 'top' && input.method != 'bottom'",
+          condition = "input.method != 'top' && input.method != 'bottom' && input.method != 'words' && input.method != 'characters'",
           ns = ns,
           checkboxInput(
             inputId = ns("right"),
@@ -1376,7 +1414,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
         data <- data_r()
         rv$data <- data
         vars_num <- vapply(data, \(.x){
-          is.numeric(.x) || is_datetime(.x) || (is.factor(.x) && length(levels(.x)) > 2)
+          is.numeric(.x) || is_datetime(.x) || (is.factor(.x) && length(levels(.x)) > 2) || is.character(.x)
         }, logical(1))
         vars_num <- names(vars_num)[vars_num]
 
@@ -1498,6 +1536,12 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
             "top",
             "bottom"
           )
+        } else if ("character" %in% class(data[[variable]])) {
+          choices <- c(
+            choices,
+            "characters",
+            "words"
+          )
         } else {
           choices <- c(
             choices,
@@ -1576,7 +1620,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           list(var = f, brks = levels(f))
         } else if (input$method %in% c(
           "top",
-          "bottom"
+          "bottom",
+          "characters",
+          "words"
         )) {
           # This allows factor simplification to get the top or bottom count
           f <- cut_var(data[[variable]], breaks = input$n_breaks)
@@ -1691,7 +1737,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           responseName = "count"
         )
         count_data$freq <- paste(signif(count_data$count / nrow(data) * 100, 3), "%")
-        # browser()
         gridTheme <- getOption("datagrid.theme")
         if (length(gridTheme) < 1) {
           datamods:::apply_grid_theme()
@@ -1758,6 +1803,9 @@ plot_histogram <- function(data, column = NULL, bins = 30, breaks = NULL, color
   } else {
     x <- data[[column]]
   }
+  if (is.character(x)){
+    x <- REDCapCAST::as_factor(x)
+  }
   x <- as.numeric(x)
   op <- par(mar = rep(1.5, 4))
   on.exit(par(op))
@@ -1833,6 +1881,18 @@ cut_methods <- function() {
       min = 1,
       max = 50
     ),
+    "characters" = list(
+      descr = i18n$t("Shorten to first letters"),
+      breaks = i18n$t("Letters"),
+      min = 1,
+      max = 20
+    ),
+    "words" = list(
+      descr = i18n$t("Shorten to first words"),
+      breaks = i18n$t("Words"),
+      min = 1,
+      max = 50
+    ),
     "fixed" = list(
       descr = i18n$t("By specified numbers"),
       breaks = i18n$t("Breaks"),
@@ -4369,7 +4429,7 @@ data_types <- function() {
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v25.12.1-251202'
+hosted_version <- function()'v25.12.2-251203'
 
 
 ########
@@ -12974,11 +13034,14 @@ server <- function(input, output, session) {
     data_r = reactive(rv$data)
   )
 
-  shiny::observeEvent(data_modal_update(), {
+  shiny::observeEvent(
+    data_modal_update(),
+    {
       shiny::removeModal()
       rv$data <- data_modal_update()
       rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
-  })
+    }
+  )
 
   #########  Split string
 
@@ -12998,6 +13061,7 @@ server <- function(input, output, session) {
   shiny::observeEvent(
     data_modal_string(),
     {
+      shiny::removeModal()
       rv$data <- data_modal_string()
       rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
     }

inst/translations/translation_da.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

inst/translations/translation_de.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

inst/translations/translation_sv.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

inst/translations/translation_sw.csv

@@ -295,3 +295,7 @@
 "Level of detail","Level of detail"
 "Minimal","Minimal"
 "Extensive","Extensive"
+"Letters","Letters"
+"Words","Words"
+"Shorten to first letters","Shorten to first letters"
+"Shorten to first words","Shorten to first words"

man/cut_var.Rd

@@ -8,6 +8,7 @@
 \alias{cut_var.POSIXct}
 \alias{cut_var.Date}
 \alias{cut_var.factor}
+\alias{cut_var.character}
 \title{Extended cutting function with fall-back to the native base::cut}
 \usage{
 cut_var(x, ...)
@@ -37,6 +38,8 @@ cut_var(x, ...)
 \method{cut_var}{Date}(x, breaks = NULL, start.on.monday = TRUE, ...)
 
 \method{cut_var}{factor}(x, breaks = NULL, type = c("top", "bottom"), other = "Other", ...)
+
+\method{cut_var}{character}(x, breaks = NULL, type = c("characters", "words"), ...)
 }
 \arguments{
 \item{x}{an object inheriting from class "POSIXct"}
@@ -48,12 +51,16 @@ cut_var(x, ...)
 \value{
 factor
 
+factor
+
 factor
 }
 \description{
 Extended cutting function with fall-back to the native base::cut
 
 Simplify a factor to only the top or bottom n levels
+
+Subset first part of string to factor
 }
 \examples{
 readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "08:20:20", "21:20:20", "03:02:20")) |> cut_var(2)
@@ -80,4 +87,5 @@ mtcars$carb |>
   as.factor() |>
   cut_var(20, "bottom") |>
   table()
+c("Sunday", "This week is short") |> cut_var(breaks = 3)
 }