diff --git a/CITATION.cff b/CITATION.cff index 29f48145..f026dade 100644 --- a/CITATION.cff +++ b/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 diff --git a/DESCRIPTION b/DESCRIPTION index 87cc929d..5a9123e7 100644 --- a/DESCRIPTION +++ b/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")), diff --git a/NAMESPACE b/NAMESPACE index 186ab21a..cbc6d0ec 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 07731215..5f097c19 100644 --- a/NEWS.md +++ b/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. diff --git a/R/app_version.R b/R/app_version.R index eca6bb3a..5e843a23 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.5.2' +app_version <- function()'25.5.4' diff --git a/R/contrast_text.R b/R/contrast_text.R index 9ea4c5ba..1db2e562 100644 --- a/R/contrast_text.R +++ b/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', diff --git a/R/create-column-mod.R b/R/create-column-mod.R index 9bb71c49..0bc24026 100644 --- a/R/create-column-mod.R +++ b/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()) { diff --git a/R/cut-variable-dates.R b/R/cut-variable-dates.R index d3f95eb5..9c78e73c 100644 --- a/R/cut-variable-dates.R +++ b/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) { diff --git a/R/data_plots.R b/R/data_plots.R index 8401bf87..1b07f43b 100644 --- a/R/data_plots.R +++ b/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 diff --git a/R/datagrid-infos-mod.R b/R/datagrid-infos-mod.R index 1a250d77..8d898f77 100644 --- a/R/datagrid-infos-mod.R +++ b/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" diff --git a/R/helpers.R b/R/helpers.R index 377badb5..73129194 100644 --- a/R/helpers.R +++ b/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) +} diff --git a/R/hosted_version.R b/R/hosted_version.R index 5feb2555..596d4e21 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.5.2-250508' +hosted_version <- function()'v25.5.4-250510' diff --git a/R/plot_euler.R b/R/plot_euler.R index 4dff9de5..10156b74 100644 --- a/R/plot_euler.R +++ b/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") } diff --git a/R/plot_hbar.R b/R/plot_hbar.R index 84ead0da..deac70c0 100644 --- a/R/plot_hbar.R +++ b/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){ diff --git a/R/plot_sankey.R b/R/plot_sankey.R index 473e7b77..c45d46f2 100644 --- a/R/plot_sankey.R +++ b/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", diff --git a/R/redcap.R b/R/redcap.R deleted file mode 100644 index e69de29b..00000000 diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index 8857e5f0..9499e7d3 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -200,9 +200,12 @@ m_redcap_readServer <- function(id) { ) # browser() - shiny::withProgress({ - imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE) - },message = paste("Connecting to",data_rv$uri)) + shiny::withProgress( + { + 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, { - datamods::show_data( + shiny::observeEvent(input$see_dd, { + 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", - !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , + parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")] + + 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$b(phosphoricons::ph("check", weight = "bold"), "Success!"), - data_rv$data_message + # tags$p( + # tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + # 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 { diff --git a/R/regression_model.R b/R/regression_model.R index 252cbf16..df79cc16 100644 --- a/R/regression_model.R +++ b/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) & diff --git a/R/sysdata.rda b/R/sysdata.rda index 57d54ffe..080cfc43 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R index a3943495..3fd4719e 100644 --- a/R/update-factor-ext.R +++ b/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, diff --git a/R/update-variables-ext.R b/R/update-variables-ext.R index eb20a11a..dbc64f8a 100644 --- a/R/update-variables-ext.R +++ b/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()]. diff --git a/README.md b/README.md index 99d8d012..66297f9b 100644 --- a/README.md +++ b/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/) -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! diff --git a/SESSION.md b/SESSION.md index da151864..dc20f495 100644 --- a/SESSION.md +++ b/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 | -|FreesearchR |25.5.2.250508 | +|quarto |1.7.30 @ /usr/local/bin/quarto | +|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) | diff --git a/_pkgdown.yml b/_pkgdown.yml index 47ca9e1b..7391d304 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -11,7 +11,7 @@ template: # Adding the switch destroys the theme colors light-switch: false includes: - in_header: + in_header: navbar: bg: primary diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index e9886d65..7dff7246 100644 --- a/inst/apps/FreesearchR/app.R +++ b/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( - 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() @@ -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")) - 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){ @@ -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({ - imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE) - },message = paste("Connecting to",data_rv$uri)) + shiny::withProgress( + { + 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, { - datamods::show_data( + shiny::observeEvent(input$see_dd, { + 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", - !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , + parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")] + + 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$b(phosphoricons::ph("check", weight = "bold"), "Success!"), - data_rv$data_message + # tags$p( + # tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + # 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) { - 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)) { @@ -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( - condition = "input.source=='redcap'", - DT::DTOutput(outputId = "redcap_prev") - ), + # shiny::conditionalPanel( + # condition = "input.source=='redcap'", + # 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") - show("main_content") + shinyjs::hide("loading_page") + 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( - { - DT::datatable(head(from_redcap$data(), 5), - caption = "First 5 observations" - ) - }, - server = TRUE - ) + # output$redcap_prev <- DT::renderDT( + # { + # DT::datatable(head(from_redcap$data(), 5), + # caption = "First 5 observations" + # ) + # }, + # server = TRUE + # ) from_env <- datamods::import_globalenv_server( id = "env", diff --git a/man/cut-variable.Rd b/man/cut-variable.Rd index 6403fa7f..67a125cd 100644 --- a/man/cut-variable.Rd +++ b/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 diff --git a/man/get_label.Rd b/man/get_label.Rd index 59643d65..c4484304 100644 --- a/man/get_label.Rd +++ b/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() } diff --git a/man/plot_sankey_single.Rd b/man/plot_sankey_single.Rd index 6b2e7888..83742a75 100644 --- a/man/plot_sankey_single.Rd +++ b/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") } diff --git a/man/simple_snake.Rd b/man/simple_snake.Rd new file mode 100644 index 00000000..f79ba9a4 --- /dev/null +++ b/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() +}