docs

CITATION.cff

@@ -9,7 +9,7 @@ type: software
 license: AGPL-3.0-or-later
 title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers
   with publication ready output'
-version: 25.5.2
+version: 25.5.4
 doi: 10.5281/zenodo.14527429
 identifiers:
 - type: url

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FreesearchR
 Title: A free and open-source browser based data analysis tool for researchers with publication ready output
-Version: 25.5.2
+Version: 25.5.4
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154")),

NAMESPACE

@@ -108,6 +108,7 @@ export(sankey_ready)
 export(selectInputIcon)
 export(set_column_label)
 export(show_data)
+export(simple_snake)
 export(sort_by)
 export(specify_qmd_format)
 export(subset_types)
@@ -130,7 +131,6 @@ export(write_quarto)
 importFrom(classInt,classIntervals)
 importFrom(data.table,as.data.table)
 importFrom(data.table,data.table)
-importFrom(grDevices,col2rgb)
 importFrom(graphics,abline)
 importFrom(graphics,axis)
 importFrom(graphics,hist)
@@ -141,7 +141,6 @@ importFrom(htmltools,css)
 importFrom(htmltools,tagList)
 importFrom(htmltools,tags)
 importFrom(htmltools,validateCssUnit)
-importFrom(phosphoricons,ph)
 importFrom(rlang,"%||%")
 importFrom(rlang,call2)
 importFrom(rlang,expr)
@@ -160,25 +159,20 @@ importFrom(shiny,isTruthy)
 importFrom(shiny,modalDialog)
 importFrom(shiny,moduleServer)
 importFrom(shiny,numericInput)
-importFrom(shiny,observe)
 importFrom(shiny,observeEvent)
 importFrom(shiny,plotOutput)
 importFrom(shiny,reactive)
 importFrom(shiny,reactiveValues)
 importFrom(shiny,renderPlot)
-importFrom(shiny,renderUI)
 importFrom(shiny,req)
 importFrom(shiny,restoreInput)
 importFrom(shiny,selectizeInput)
 importFrom(shiny,showModal)
 importFrom(shiny,tagList)
-importFrom(shiny,textAreaInput)
 importFrom(shiny,textInput)
 importFrom(shiny,uiOutput)
 importFrom(shiny,updateActionButton)
-importFrom(shiny,updateTextAreaInput)
 importFrom(shinyWidgets,WinBox)
-importFrom(shinyWidgets,alert)
 importFrom(shinyWidgets,noUiSliderInput)
 importFrom(shinyWidgets,prettyCheckbox)
 importFrom(shinyWidgets,updateVirtualSelect)

NEWS.md

@@ -1,3 +1,21 @@
+# FreesearchR 25.5.4
+
+- *FIX* correctly omit NAs in `data_type()` call
+
+- *FIX* omit NAs when plotting Euler diagrams.
+
+- *FIX* print correct labels in horizontal stacked bars.
+
+- *FIX* initial app load should feel faster.
+
+# FreesearchR 25.5.3
+
+- *FIX* a little polish on the data import
+
+- *FIX* polished REDCap import and new code to reference the `REDCapCAST::easy_redcap()` function.
+
+- *FIX* updated documentation to reflect new private hosting on a Hetzner server in Germany.
+
 # FreesearchR 25.5.2
 
 - *FIX*: correct export of plots. The solution in the last version broke more than it solved.

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'25.5.2'
+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(
+   shiny::tags$head(
-    tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
+    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/datagrid-infos-mod.R

@@ -35,7 +35,7 @@ show_data <- function(data,
   if (is.null(options))
     options <- list()
 
-  options$height <- 550
+  options$height <- 500
   options$minBodyHeight <- 400
   options$data <- data
   options$theme <- "default"

R/helpers.R

@@ -652,3 +652,17 @@ is_identical_to_previous <- function(data, no.name = TRUE) {
     }
   }, FUN.VALUE = logical(1))
 }
+
+
+#' Simplified version of the snakecase packages to_snake_case
+#'
+#' @param data character string vector
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F  OO bar") |> simple_snake()
+simple_snake <- function(data){
+  gsub("[\\s+]","_",gsub("[^\\w\\s:-]", "", tolower(data), perl=TRUE), perl=TRUE)
+}

R/hosted_version.R

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

R/plot_euler.R

@@ -87,10 +87,11 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
   out <- lapply(ds, \(.x){
     .x[c(pri, sec)] |>
       as.data.frame() |>
+      na.omit() |>
       plot_euler_single()
   })
 
-# names(out)
+  # names(out)
   wrap_plot_list(out)
   # patchwork::wrap_plots(out, guides = "collect")
 }

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"))
+  score_label <- data |> get_label(var = score)
-  group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label"))
+  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/redcap_read_shiny_module.R

@@ -200,9 +200,12 @@ m_redcap_readServer <- function(id) {
             )
 
             # browser()
-            shiny::withProgress({
+            shiny::withProgress(
-              imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
+              {
-            },message = paste("Connecting to",data_rv$uri))
+                imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
+              },
+              message = paste("Connecting to", data_rv$uri)
+            )
 
             ## TODO: Simplify error messages
             if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
@@ -228,7 +231,7 @@ m_redcap_readServer <- function(id) {
                 status = "success",
                 include_data_alert(
                   see_data_text = "Click to see data dictionary",
-                  dataIdName = "see_data",
+                  dataIdName = "see_dd",
                   extra = tags$p(
                     tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
                     glue::glue("The {data_rv$info$project_title} project is loaded.")
@@ -254,8 +257,8 @@ m_redcap_readServer <- function(id) {
     output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
     shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
 
-    shiny::observeEvent(input$see_data, {
+    shiny::observeEvent(input$see_dd, {
-      datamods::show_data(
+      show_data(
         purrr::pluck(data_rv$dd_list, "data"),
         title = "Data dictionary",
         type = "modal",
@@ -264,6 +267,17 @@ m_redcap_readServer <- function(id) {
       )
     })
 
+    shiny::observeEvent(input$see_data, {
+      show_data(
+        # purrr::pluck(data_rv$dd_list, "data"),
+        data_rv$data,
+        title = "Imported data set",
+        type = "modal",
+        show_classes = FALSE,
+        tags$b("Preview:")
+      )
+    })
+
     arms <- shiny::reactive({
       shiny::req(input$api)
       shiny::req(data_rv$uri)
@@ -378,13 +392,24 @@ m_redcap_readServer <- function(id) {
         imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
       })
 
-      code <- rlang::call2("read_redcap_tables",
+      parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
-        !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
+
+      code <- rlang::call2(
+        "easy_redcap",
+        !!!utils::modifyList(
+          parameters_code,
+          list(
+            data_format = ifelse(
+              input$data_type == "long" && !is.null(input$data_type),
+              "long",
+              "wide"
+            ),
+            project.name = simple_snake(data_rv$info$project_title)
+          )
+        ),
         .ns = "REDCapCAST"
       )
 
-      # browser()
-
       if (inherits(imported, "try-error") || NROW(imported) < 1) {
         data_rv$data_status <- "error"
         data_rv$data_list <- NULL
@@ -453,9 +478,17 @@ m_redcap_readServer <- function(id) {
           datamods:::insert_alert(
             selector = ns("retrieved"),
             status = data_rv$data_status,
-            tags$p(
+            # tags$p(
-              tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+            #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
-              data_rv$data_message
+            #   data_rv$data_message
+            # ),
+            include_data_alert(
+              see_data_text = "Click to see the imported data",
+              dataIdName = "see_data",
+              extra = tags$p(
+                tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
+              ),
+              btn_show_data = TRUE
             )
           )
         } else {

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) {
+    } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) {
-      if (identical("logical", cl_d) | length(unique(data)) == 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()].

README.md

@@ -7,9 +7,9 @@
 [![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/FreesearchR/)
 <!-- badges: end -->
 
-The [***FreesearchR***](https://agdamsbo.shinyapps.io/FreesearchR/) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results.
+The [***FreesearchR***](https://app.freesearchr.org) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results.
 
-[***FreesearchR***](https://agdamsbo.shinyapps.io/FreesearchR/) is free and open-source, and is directly accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearchR/). The app can also run locally, please see below.
+[***FreesearchR***](https://app.freesearchr.org) is free and open-source, and is [accessible in your web browser through this link](https://app.freesearchr.org). The app can also run locally, please [see below](#run-locally-on-your-own-machine-sec-run-locally).
 
 All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out!
 

SESSION.md

@@ -11,11 +11,11 @@
 |collate     |en_US.UTF-8                                |
 |ctype       |en_US.UTF-8                                |
 |tz          |Europe/Copenhagen                          |
-|date        |2025-05-08                                 |
+|date        |2025-05-10                                 |
 |rstudio     |2024.12.1+563 Kousa Dogwood (desktop)      |
 |pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
-|quarto      |1.6.40 @ /usr/local/bin/quarto             |
+|quarto      |1.7.30 @ /usr/local/bin/quarto             |
-|FreesearchR |25.5.2.250508                              |
+|FreesearchR |25.5.4.250510                              |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -44,7 +44,6 @@
 |commonmark    |1.9.5         |2025-03-17 |CRAN (R 4.4.1) |
 |correlation   |0.8.7         |2025-03-03 |CRAN (R 4.4.1) |
 |crayon        |1.5.3         |2024-06-20 |CRAN (R 4.4.1) |
-|crosstalk     |1.2.1         |2023-11-23 |CRAN (R 4.4.0) |
 |curl          |6.2.2         |2025-03-24 |CRAN (R 4.4.1) |
 |data.table    |1.17.0        |2025-02-22 |CRAN (R 4.4.1) |
 |datamods      |1.5.3         |2024-10-02 |CRAN (R 4.4.1) |
@@ -59,6 +58,7 @@
 |easystats     |0.7.4         |2025-02-06 |CRAN (R 4.4.1) |
 |effectsize    |1.0.0         |2024-12-10 |CRAN (R 4.4.1) |
 |ellipsis      |0.3.2         |2021-04-29 |CRAN (R 4.4.1) |
+|eulerr        |7.0.2         |2024-03-28 |CRAN (R 4.4.0) |
 |evaluate      |1.0.3         |2025-01-10 |CRAN (R 4.4.1) |
 |farver        |2.1.2         |2024-05-13 |CRAN (R 4.4.1) |
 |fastmap       |1.2.0         |2024-05-15 |CRAN (R 4.4.1) |
@@ -66,8 +66,11 @@
 |forcats       |1.0.0         |2023-01-29 |CRAN (R 4.4.0) |
 |fs            |1.6.6         |2025-04-12 |CRAN (R 4.4.1) |
 |generics      |0.1.3         |2022-07-05 |CRAN (R 4.4.1) |
+|ggalluvial    |0.12.5        |2023-02-22 |CRAN (R 4.4.0) |
+|ggforce       |0.4.2         |2024-02-19 |CRAN (R 4.4.0) |
 |ggplot2       |3.5.2         |2025-04-09 |CRAN (R 4.4.1) |
 |glue          |1.8.0         |2024-09-30 |CRAN (R 4.4.1) |
+|gridExtra     |2.3           |2017-09-09 |CRAN (R 4.4.1) |
 |gt            |1.0.0         |2025-04-05 |CRAN (R 4.4.1) |
 |gtable        |0.3.6         |2024-10-25 |CRAN (R 4.4.1) |
 |gtsummary     |2.2.0         |2025-04-14 |CRAN (R 4.4.1) |
@@ -85,6 +88,7 @@
 |KernSmooth    |2.23-26       |2025-01-01 |CRAN (R 4.4.1) |
 |keyring       |1.3.2         |2023-12-11 |CRAN (R 4.4.0) |
 |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 |CRAN (R 4.4.1) |
 |lattice       |0.22-7        |2025-04-02 |CRAN (R 4.4.1) |
 |lifecycle     |1.0.4         |2023-11-07 |CRAN (R 4.4.1) |
@@ -101,7 +105,6 @@
 |nloptr        |2.2.1         |2025-03-17 |CRAN (R 4.4.1) |
 |openssl       |2.3.2         |2025-02-03 |CRAN (R 4.4.1) |
 |openxlsx2     |1.15          |2025-04-25 |CRAN (R 4.4.1) |
-|pak           |0.8.0.2       |2025-04-08 |CRAN (R 4.4.1) |
 |parameters    |0.24.2        |2025-03-04 |CRAN (R 4.4.1) |
 |patchwork     |1.3.0         |2024-09-16 |CRAN (R 4.4.1) |
 |performance   |0.13.0        |2025-01-15 |CRAN (R 4.4.1) |
@@ -110,6 +113,8 @@
 |pkgbuild      |1.4.7         |2025-03-24 |CRAN (R 4.4.1) |
 |pkgconfig     |2.0.3         |2019-09-22 |CRAN (R 4.4.1) |
 |pkgload       |1.4.0         |2024-06-28 |CRAN (R 4.4.0) |
+|polyclip      |1.10-7        |2024-07-23 |CRAN (R 4.4.1) |
+|polylabelr    |0.3.0         |2024-11-19 |CRAN (R 4.4.1) |
 |processx      |3.8.6         |2025-02-21 |CRAN (R 4.4.1) |
 |profvis       |0.4.0         |2024-09-20 |CRAN (R 4.4.1) |
 |promises      |1.3.2         |2024-11-28 |CRAN (R 4.4.1) |
@@ -122,6 +127,8 @@
 |R.oo          |1.27.0        |2024-11-01 |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 |CRAN (R 4.4.1) |
+|rankinPlot    |1.1.0         |2023-01-30 |CRAN (R 4.4.0) |
 |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.0.14        |2025-01-12 |CRAN (R 4.4.1) |
@@ -139,6 +146,7 @@
 |rio           |1.2.3         |2024-09-25 |CRAN (R 4.4.1) |
 |rlang         |1.1.6         |2025-04-11 |CRAN (R 4.4.1) |
 |rmarkdown     |2.29          |2024-11-04 |CRAN (R 4.4.1) |
+|roxygen2      |7.3.2         |2024-06-28 |CRAN (R 4.4.0) |
 |rprojroot     |2.0.4         |2023-11-05 |CRAN (R 4.4.1) |
 |rsconnect     |1.3.4         |2025-01-22 |CRAN (R 4.4.1) |
 |rstudioapi    |0.17.1        |2024-10-22 |CRAN (R 4.4.1) |
@@ -152,16 +160,23 @@
 |shinyTime     |1.0.3         |2022-08-19 |CRAN (R 4.4.0) |
 |shinyWidgets  |0.9.0         |2025-02-21 |CRAN (R 4.4.1) |
 |stringi       |1.8.7         |2025-03-27 |CRAN (R 4.4.1) |
+|stringr       |1.5.1         |2023-11-14 |CRAN (R 4.4.0) |
 |styler        |1.10.3        |2024-04-07 |CRAN (R 4.4.0) |
+|systemfonts   |1.2.2         |2025-04-04 |CRAN (R 4.4.1) |
+|textshaping   |1.0.0         |2025-01-20 |CRAN (R 4.4.1) |
 |tibble        |3.2.1         |2023-03-20 |CRAN (R 4.4.0) |
 |tidyr         |1.3.1         |2024-01-24 |CRAN (R 4.4.1) |
 |tidyselect    |1.2.1         |2024-03-11 |CRAN (R 4.4.0) |
 |toastui       |0.4.0         |2025-04-03 |CRAN (R 4.4.1) |
+|tweenr        |2.0.3         |2024-02-26 |CRAN (R 4.4.0) |
 |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 |CRAN (R 4.4.1) |
+|utf8          |1.2.4         |2023-10-22 |CRAN (R 4.4.1) |
 |V8            |6.0.3         |2025-03-26 |CRAN (R 4.4.1) |
 |vctrs         |0.6.5         |2023-12-01 |CRAN (R 4.4.0) |
+|viridis       |0.6.5         |2024-01-29 |CRAN (R 4.4.0) |
+|viridisLite   |0.4.2         |2023-05-02 |CRAN (R 4.4.1) |
 |vroom         |1.6.5         |2023-12-05 |CRAN (R 4.4.0) |
 |withr         |3.0.2         |2024-10-28 |CRAN (R 4.4.1) |
 |writexl       |1.5.4         |2025-04-15 |CRAN (R 4.4.1) |

_pkgdown.yml

@@ -11,7 +11,7 @@ template:
   # Adding the switch destroys the theme colors
   light-switch: false
   includes:
-    in_header: <script defer src="https://analytics.gdamsbo.dk/script.js" data-website-id="1f3baf18-29aa-4612-931b-58ea35922ae4"></script>
+    in_header: <script defer src="https://stats.freesearchr.org/script.js" data-website-id="85bfd1e8-2cbe-4a4a-aa34-1dfb2960905b"></script>
 
 navbar:
   bg: primary

inst/apps/FreesearchR/app.R

@@ -1,5 +1,44 @@
 
 
+########
+#### Current file: /Users/au301842/FreesearchR/app/libs.R 
+########
+
+library(shiny)
+# library(shinyjs)
+# library(methods)
+# library(readr)
+# library(MASS)
+# library(stats)
+# library(gt)
+# library(openxlsx2)
+# library(haven)
+# library(readODS)
+# library(bslib)
+# library(assertthat)
+# library(dplyr)
+# library(quarto)
+# library(here)
+# library(broom)
+# library(broom.helpers)
+# library(easystats)
+# library(patchwork)
+# library(DHARMa)
+# library(apexcharter)
+library(toastui)
+# library(datamods)
+# library(IDEAFilter)
+library(shinyWidgets)
+# library(DT)
+# library(data.table)
+# library(gtsummary)
+library(bsicons)
+library(rlang)
+# library(datamods)
+# library(toastui)
+# library(phosphoricons)
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/app/functions.R 
 ########
@@ -10,7 +49,7 @@
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'25.5.2'
+app_version <- function()'25.5.3'
 
 
 ########
@@ -129,7 +168,6 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS
 #' contrast_text(c("#F2F2F2", "blue"), method="relative")
 #' @export
 #'
-#' @importFrom grDevices col2rgb
 #'
 contrast_text <- function(background,
                           light_text = 'white',
@@ -323,20 +361,17 @@ sentence_paste <- function(data, and.str = "and") {
 #' @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(
+   shiny::tags$head(
-    tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
+    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()
@@ -390,7 +425,7 @@ create_column_ui <- function(id) {
         )
       )
     ),
-    textAreaInput(
+    shiny::textAreaInput(
       inputId = ns("expression"),
       label = i18n("Enter an expression to define new column:"),
       value = "",
@@ -438,9 +473,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()) {
@@ -947,12 +979,6 @@ vectorSelectInput <- function(inputId,
 #### Current file: /Users/au301842/FreesearchR/R//cut-variable-dates.R 
 ########
 
-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"
@@ -1161,9 +1187,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%"
         )
@@ -1176,7 +1202,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,
@@ -1187,12 +1213,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
         )
       )
@@ -1203,10 +1229,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")
@@ -1237,7 +1263,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]
@@ -1274,9 +1300,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,
@@ -1331,7 +1357,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%"
@@ -1474,7 +1500,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)
@@ -1490,14 +1516,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,
@@ -1525,7 +1551,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) {
@@ -2255,6 +2281,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
@@ -2983,7 +3010,7 @@ show_data <- function(data,
   if (is.null(options))
     options <- list()
 
-  options$height <- 550
+  options$height <- 500
   options$minBodyHeight <- 400
   options$data <- data
   options$theme <- "default"
@@ -3951,11 +3978,25 @@ is_identical_to_previous <- function(data, no.name = TRUE) {
 }
 
 
+#' Simplified version of the snakecase packages to_snake_case
+#'
+#' @param data character string vector
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F  OO bar") |> simple_snake()
+simple_snake <- function(data){
+  gsub("[\\s+]","_",gsub("[^\\w\\s:-]", "", tolower(data), perl=TRUE), perl=TRUE)
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v25.5.2-250508'
+hosted_version <- function()'v25.5.3-250510'
 
 
 ########
@@ -4793,10 +4834,11 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
   out <- lapply(ds, \(.x){
     .x[c(pri, sec)] |>
       as.data.frame() |>
+      na.omit() |>
       plot_euler_single()
   })
 
-# names(out)
+  # names(out)
   wrap_plot_list(out)
   # patchwork::wrap_plots(out, guides = "collect")
 }
@@ -4908,9 +4950,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"))
+  score_label <- data |> get_label(var = score)
-  group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label"))
+  group_label <- data |> get_label(var = group)
-
 
   p |>
     (\(.x){
@@ -5100,7 +5141,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)
@@ -5113,8 +5153,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"
 
@@ -5178,6 +5216,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",
@@ -5566,9 +5606,12 @@ m_redcap_readServer <- function(id) {
             )
 
             # browser()
-            shiny::withProgress({
+            shiny::withProgress(
-              imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
+              {
-            },message = paste("Connecting to",data_rv$uri))
+                imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
+              },
+              message = paste("Connecting to", data_rv$uri)
+            )
 
             ## TODO: Simplify error messages
             if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
@@ -5594,7 +5637,7 @@ m_redcap_readServer <- function(id) {
                 status = "success",
                 include_data_alert(
                   see_data_text = "Click to see data dictionary",
-                  dataIdName = "see_data",
+                  dataIdName = "see_dd",
                   extra = tags$p(
                     tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
                     glue::glue("The {data_rv$info$project_title} project is loaded.")
@@ -5620,8 +5663,8 @@ m_redcap_readServer <- function(id) {
     output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
     shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
 
-    shiny::observeEvent(input$see_data, {
+    shiny::observeEvent(input$see_dd, {
-      datamods::show_data(
+      show_data(
         purrr::pluck(data_rv$dd_list, "data"),
         title = "Data dictionary",
         type = "modal",
@@ -5630,6 +5673,17 @@ m_redcap_readServer <- function(id) {
       )
     })
 
+    shiny::observeEvent(input$see_data, {
+      show_data(
+        # purrr::pluck(data_rv$dd_list, "data"),
+        data_rv$data,
+        title = "Imported data set",
+        type = "modal",
+        show_classes = FALSE,
+        tags$b("Preview:")
+      )
+    })
+
     arms <- shiny::reactive({
       shiny::req(input$api)
       shiny::req(data_rv$uri)
@@ -5744,13 +5798,24 @@ m_redcap_readServer <- function(id) {
         imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
       })
 
-      code <- rlang::call2("read_redcap_tables",
+      parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
-        !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
+
+      code <- rlang::call2(
+        "easy_redcap",
+        !!!utils::modifyList(
+          parameters_code,
+          list(
+            data_format = ifelse(
+              input$data_type == "long" && !is.null(input$data_type),
+              "long",
+              "wide"
+            ),
+            project.name = simple_snake(data_rv$info$project_title)
+          )
+        ),
         .ns = "REDCapCAST"
       )
 
-      # browser()
-
       if (inherits(imported, "try-error") || NROW(imported) < 1) {
         data_rv$data_status <- "error"
         data_rv$data_list <- NULL
@@ -5819,9 +5884,17 @@ m_redcap_readServer <- function(id) {
           datamods:::insert_alert(
             selector = ns("retrieved"),
             status = data_rv$data_status,
-            tags$p(
+            # tags$p(
-              tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+            #   tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
-              data_rv$data_message
+            #   data_rv$data_message
+            # ),
+            include_data_alert(
+              see_data_text = "Click to see the imported data",
+              dataIdName = "see_data",
+              extra = tags$p(
+                tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
+              ),
+              btn_show_data = TRUE
             )
           )
         } else {
@@ -6022,13 +6095,6 @@ redcap_demo_app <- function() {
 }
 
 
-########
-#### Current file: /Users/au301842/FreesearchR/R//redcap.R 
-########
-
-
-
-
 ########
 #### Current file: /Users/au301842/FreesearchR/R//regression_model.R 
 ########
@@ -6306,12 +6372,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) {
+    } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) {
-      if (identical("logical", cl_d) | length(unique(data)) == 2) {
+      if (identical("logical", cl_d) | l_unique == 2) {
         out <- "dichotomous"
       } else {
         # if (is.ordered(data)) {
@@ -6324,7 +6391,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) &
@@ -7999,7 +8066,7 @@ update_factor_ui <- function(id) {
     fluidRow(
       column(
         width = 6,
-        virtualSelectInput(
+        shinyWidgets::virtualSelectInput(
           inputId = ns("variable"),
           label = i18n("Factor variable to reorder:"),
           choices = NULL,
@@ -8034,10 +8101,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,
@@ -8263,10 +8330,6 @@ winbox_update_factor <- function(id,
 #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R 
 ########
 
-library(data.table)
-library(rlang)
-
-
 #' Select, rename and convert variables
 #'
 #' @param id Module id. See [shiny::moduleServer()].
@@ -9317,10 +9380,10 @@ ui_elements <- list(
           condition = "input.source=='env'",
           import_globalenv_ui(id = "env", title = NULL)
         ),
-        shiny::conditionalPanel(
+        # shiny::conditionalPanel(
-          condition = "input.source=='redcap'",
+        #   condition = "input.source=='redcap'",
-          DT::DTOutput(outputId = "redcap_prev")
+        #   DT::DTOutput(outputId = "redcap_prev")
-        ),
+        # ),
         shiny::conditionalPanel(
           condition = "output.data_loaded == true",
           shiny::br(),
@@ -9329,13 +9392,8 @@ ui_elements <- list(
           shiny::fluidRow(
             shiny::column(
               width = 6,
+              shiny::p("Filter by completeness threshold:"),
               shiny::br(),
-              shiny::p("Filter by completeness threshold and manual selection:"),
-              shiny::br(),
-              shiny::br()
-            ),
-            shiny::column(
-              width = 6,
               shinyWidgets::noUiSliderInput(
                 inputId = "complete_cutoff",
                 label = NULL,
@@ -9348,12 +9406,17 @@ ui_elements <- list(
                 color = datamods:::get_primary_color()
               ),
               shiny::helpText("Exclude variables with completeness below the specified percentage."),
-              shiny::br(),
+              shiny::br()
+            ),
+            shiny::column(
+              width = 6,
+              shiny::p("Specify manually:"),
               shiny::br(),
               shiny::uiOutput(outputId = "import_var"),
-              shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
+              shiny::br()
             )
-          )
+          ),
+          shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
         ),
         shiny::br(),
         shiny::br(),
@@ -9830,33 +9893,7 @@ ui <- bslib::page_fixed(
 #### Current file: /Users/au301842/FreesearchR/app/server.R 
 ########
 
-library(readr)
+
-library(MASS)
-library(stats)
-library(gt)
-# library(openxlsx2)
-library(haven)
-library(readODS)
-require(shiny)
-library(bslib)
-library(assertthat)
-library(dplyr)
-library(quarto)
-library(here)
-library(broom)
-library(broom.helpers)
-library(easystats)
-library(patchwork)
-library(DHARMa)
-library(apexcharter)
-library(toastui)
-library(datamods)
-library(IDEAFilter)
-library(shinyWidgets)
-library(DT)
-library(data.table)
-library(gtsummary)
-library(shinyjs)
 
 data(starwars)
 data(mtcars)
@@ -9864,8 +9901,8 @@ data(trial)
 
 load_data <- function() {
   Sys.sleep(1)
-  hide("loading_page")
+  shinyjs::hide("loading_page")
-  show("main_content")
+  shinyjs::show("main_content")
 }
 
 
@@ -9946,14 +9983,14 @@ server <- function(input, output, session) {
   })
 
   ## This is used to ensure the reactive data is retrieved
-  output$redcap_prev <- DT::renderDT(
+  # output$redcap_prev <- DT::renderDT(
-    {
+  #   {
-      DT::datatable(head(from_redcap$data(), 5),
+  #     DT::datatable(head(from_redcap$data(), 5),
-        caption = "First 5 observations"
+  #       caption = "First 5 observations"
-      )
+  #     )
-    },
+  #   },
-    server = TRUE
+  #   server = TRUE
-  )
+  # )
 
   from_env <- datamods::import_globalenv_server(
     id = "env",

man/cut-variable.Rd

@@ -13,7 +13,7 @@ cut_variable_server(id, data_r = reactive(NULL))
 
 modal_cut_variable(
   id,
-  title = i18n("Convert Numeric to Factor"),
+  title = datamods:::i18n("Convert Numeric to Factor"),
   easyClose = TRUE,
   size = "l",
   footer = NULL

man/get_label.Rd

@@ -22,5 +22,6 @@ mtcars |> get_label(var = "mpg")
 mtcars |> get_label()
 mtcars$mpg |> get_label()
 gtsummary::trial |> get_label(var = "trt")
+gtsummary::trial$trt |> get_label()
 1:10 |> get_label()
 }

man/plot_sankey_single.Rd

@@ -39,6 +39,5 @@ data.frame(
   plot_sankey_single("first", "last", color.group = "pri")
 mtcars |>
   default_parsing() |>
-  str()
 plot_sankey_single("cyl", "vs", color.group = "pri")
 }

man/simple_snake.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helpers.R
+\name{simple_snake}
+\alias{simple_snake}
+\title{Simplified version of the snakecase packages to_snake_case}
+\usage{
+simple_snake(data)
+}
+\arguments{
+\item{data}{character string vector}
+}
+\value{
+vector
+}
+\description{
+Simplified version of the snakecase packages to_snake_case
+}
+\examples{
+c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F  OO bar") |> simple_snake()
+}