quick additional update

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'25.5.3'
+app_version <- function()'25.5.4'

R/contrast_text.R

@@ -25,7 +25,6 @@
 #' contrast_text(c("#F2F2F2", "blue"), method="relative")
 #' @export
 #'
-#' @importFrom grDevices col2rgb
 #'
 contrast_text <- function(background,
                           light_text = 'white',

R/create-column-mod.R

@@ -17,20 +17,17 @@
 #' @export
 #'
 #' @importFrom htmltools tagList tags css
-#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton
-#' @importFrom phosphoricons ph
-#' @importFrom shinyWidgets virtualSelectInput
 #'
 #' @name create-column
 #'
 #' @example examples/create_column_module_demo.R
 create_column_ui <- function(id) {
   ns <- NS(id)
-  tagList(
+  htmltools::tagList(
     # datamods:::html_dependency_datamods(),
     # html_dependency_FreesearchR(),
-   tags$head(
-    tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
+   shiny::tags$head(
+    shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
   ),
     # tags$head(
     #   # Note the wrapping of the string in HTML()
@@ -84,7 +81,7 @@ create_column_ui <- function(id) {
         )
       )
     ),
-    textAreaInput(
+    shiny::textAreaInput(
       inputId = ns("expression"),
       label = i18n("Enter an expression to define new column:"),
       value = "",
@@ -132,9 +129,6 @@ create_column_ui <- function(id) {
 #'
 #' @rdname create-column
 #'
-#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req
-#'  updateTextAreaInput reactive bindEvent observe
-#' @importFrom shinyWidgets alert updateVirtualSelect
 create_column_server <- function(id,
                                  data_r = reactive(NULL),
                                  allowed_operations = list_allowed_operations()) {

R/cut-variable-dates.R

@@ -1,9 +1,3 @@
-library(datamods)
-library(toastui)
-library(phosphoricons)
-library(rlang)
-library(shiny)
-
 #' Extended cutting function with fall-back to the native base::cut
 #'
 #' @param x an object inheriting from class "hms"
@@ -212,9 +206,9 @@ cut_variable_ui <- function(id) {
     shiny::fluidRow(
       column(
         width = 3,
-        virtualSelectInput(
+        shinyWidgets::virtualSelectInput(
           inputId = ns("variable"),
-          label = i18n("Variable to cut:"),
+          label = datamods:::i18n("Variable to cut:"),
           choices = NULL,
           width = "100%"
         )
@@ -227,7 +221,7 @@ cut_variable_ui <- function(id) {
         width = 3,
         numericInput(
           inputId = ns("n_breaks"),
-          label = i18n("Number of breaks:"),
+          label = datamods:::i18n("Number of breaks:"),
           value = 3,
           min = 2,
           max = 12,
@@ -238,12 +232,12 @@ cut_variable_ui <- function(id) {
         width = 3,
         checkboxInput(
           inputId = ns("right"),
-          label = i18n("Close intervals on the right"),
+          label = datamods:::i18n("Close intervals on the right"),
           value = TRUE
         ),
         checkboxInput(
           inputId = ns("include_lowest"),
-          label = i18n("Include lowest value"),
+          label = datamods:::i18n("Include lowest value"),
           value = TRUE
         )
       )
@@ -254,10 +248,10 @@ cut_variable_ui <- function(id) {
       uiOutput(outputId = ns("slider_fixed"))
     ),
     plotOutput(outputId = ns("plot"), width = "100%", height = "270px"),
-    datagridOutput2(outputId = ns("count")),
+    toastui::datagridOutput2(outputId = ns("count")),
     actionButton(
       inputId = ns("create"),
-      label = tagList(ph("scissors"), i18n("Create factor variable")),
+      label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")),
       class = "btn-outline-primary float-end"
     ),
     tags$div(class = "clearfix")
@@ -288,7 +282,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           is.numeric(.x) || is_datetime(.x)
         }, logical(1))
         vars_num <- names(vars_num)[vars_num]
-        updateVirtualSelect(
+        shinyWidgets::updateVirtualSelect(
           inputId = "variable",
           choices = vars_num,
           selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
@@ -325,9 +319,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
         }
 
 
-        noUiSliderInput(
+        shinyWidgets::noUiSliderInput(
           inputId = session$ns("fixed_brks"),
-          label = i18n("Fixed breaks:"),
+          label = datamods:::i18n("Fixed breaks:"),
           min = lower,
           max = upper,
           value = brks,
@@ -382,7 +376,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
 
         shinyWidgets::virtualSelectInput(
           inputId = session$ns("method"),
-          label = i18n("Method:"),
+          label = datamods:::i18n("Method:"),
           choices = choices,
           selected = NULL,
           width = "100%"
@@ -525,7 +519,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
         data
       })
 
-      output$count <- renderDatagrid2({
+      output$count <- toastui::renderDatagrid2({
         # shiny::req(rv$new_var_name)
         data <- req(data_cutted_r())
         # variable <- req(input$variable)
@@ -541,14 +535,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           datamods:::apply_grid_theme()
         }
         on.exit(toastui::reset_grid_theme())
-        grid <- datagrid(
+        grid <- toastui::datagrid(
           data = count_data,
           colwidths = "guess",
           theme = "default",
           bodyHeight = "auto"
         )
         grid <- toastui::grid_columns(grid, className = "font-monospace")
-        grid_colorbar(
+        toastui::grid_colorbar(
           grid,
           column = "count",
           label_outside = TRUE,
@@ -576,7 +570,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
 #'
 #' @rdname cut-variable
 modal_cut_variable <- function(id,
-                               title = i18n("Convert Numeric to Factor"),
+                               title = datamods:::i18n("Convert Numeric to Factor"),
                                easyClose = TRUE,
                                size = "l",
                                footer = NULL) {

R/data_plots.R

@@ -681,6 +681,7 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
 #' mtcars |> get_label()
 #' mtcars$mpg |> get_label()
 #' gtsummary::trial |> get_label(var = "trt")
+#' gtsummary::trial$trt |> get_label()
 #' 1:10 |> get_label()
 get_label <- function(data, var = NULL) {
   # data <- if (is.reactive(data)) data() else data

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v25.5.3-250510'
+hosted_version <- function()'v25.5.4-250510'

R/plot_hbar.R

@@ -62,9 +62,8 @@ vertical_stacked_bars <- function(data,
   contrast_cut <-
     sum(contrast_text(colors, threshold = .3) == "white")
 
-  score_label <- ifelse(is.na(REDCapCAST::get_attr(data$score, "label")), score, REDCapCAST::get_attr(data$score, "label"))
-  group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label"))
-
+  score_label <- data |> get_label(var = score)
+  group_label <- data |> get_label(var = group)
 
   p |>
     (\(.x){

R/plot_sankey.R

@@ -119,7 +119,6 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors
 #'   plot_sankey_single("first", "last", color.group = "pri")
 #' mtcars |>
 #'   default_parsing() |>
-#'   str()
 #' plot_sankey_single("cyl", "vs", color.group = "pri")
 plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) {
   color.group <- match.arg(color.group)
@@ -132,8 +131,6 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
 
   data <- data |> sankey_ready(pri = pri, sec = sec, ...)
 
-  library(ggalluvial)
-
   na.color <- "#2986cc"
   box.color <- "#1E4B66"
 
@@ -197,6 +194,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
       )
   }
 
+  ## Will fail to use stat="stratum" if library is not loaded.
+  library(ggalluvial)
   p +
     ggplot2::geom_text(
       stat = "stratum",

R/regression_model.R

@@ -271,12 +271,13 @@ data_type <- function(data) {
     sapply(data, data_type)
   } else {
     cl_d <- class(data)
+    l_unique <- length(unique(na.omit(data)))
     if (all(is.na(data))) {
       out <- "empty"
-    } else if (length(unique(data)) < 2) {
+    } else if (l_unique < 2) {
       out <- "monotone"
-    } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) {
-      if (identical("logical", cl_d) | length(unique(data)) == 2) {
+    } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) {
+      if (identical("logical", cl_d) | l_unique == 2) {
         out <- "dichotomous"
       } else {
         # if (is.ordered(data)) {
@@ -289,7 +290,7 @@ data_type <- function(data) {
       out <- "text"
     } else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) {
       out <- "datetime"
-    } else if (!length(unique(data)) == 2) {
+    } else if (l_unique > 2) {
       ## Previously had all thinkable classes
       ## Now just assumes the class has not been defined above
       ## any(c("numeric", "integer", "hms", "Date", "timediff") %in% cl_d) &

R/update-factor-ext.R

@@ -31,7 +31,7 @@ update_factor_ui <- function(id) {
     fluidRow(
       column(
         width = 6,
-        virtualSelectInput(
+        shinyWidgets::virtualSelectInput(
           inputId = ns("variable"),
           label = i18n("Factor variable to reorder:"),
           choices = NULL,
@@ -66,10 +66,10 @@ update_factor_ui <- function(id) {
         )
       )
     ),
-    datagridOutput(ns("grid")),
+    toastui::datagridOutput(ns("grid")),
     tags$div(
       class = "float-end",
-      prettyCheckbox(
+      shinyWidgets::prettyCheckbox(
         inputId = ns("new_var"),
         label = i18n("Create a new variable (otherwise replaces the one selected)"),
         value = FALSE,

R/update-variables-ext.R

@@ -1,7 +1,3 @@
-library(data.table)
-library(rlang)
-
-
 #' Select, rename and convert variables
 #'
 #' @param id Module id. See [shiny::moduleServer()].