diff --git a/CITATION.cff b/CITATION.cff index f026dade..29f48145 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.4 +version: 25.5.2 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index 5a9123e7..87cc929d 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.4 +Version: 25.5.2 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 cbc6d0ec..186ab21a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -108,7 +108,6 @@ 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) @@ -131,6 +130,7 @@ 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,6 +141,7 @@ importFrom(htmltools,css) importFrom(htmltools,tagList) importFrom(htmltools,tags) importFrom(htmltools,validateCssUnit) +importFrom(phosphoricons,ph) importFrom(rlang,"%||%") importFrom(rlang,call2) importFrom(rlang,expr) @@ -159,20 +160,25 @@ 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 5f097c19..07731215 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,21 +1,3 @@ -# 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 5e843a23..eca6bb3a 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.5.4' +app_version <- function()'25.5.2' diff --git a/R/contrast_text.R b/R/contrast_text.R index 1db2e562..9ea4c5ba 100644 --- a/R/contrast_text.R +++ b/R/contrast_text.R @@ -25,6 +25,7 @@ #' 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 0bc24026..9bb71c49 100644 --- a/R/create-column-mod.R +++ b/R/create-column-mod.R @@ -17,17 +17,20 @@ #' @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) - htmltools::tagList( + tagList( # datamods:::html_dependency_datamods(), # html_dependency_FreesearchR(), - shiny::tags$head( - shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + tags$head( + tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") ), # tags$head( # # Note the wrapping of the string in HTML() @@ -81,7 +84,7 @@ create_column_ui <- function(id) { ) ) ), - shiny::textAreaInput( + textAreaInput( inputId = ns("expression"), label = i18n("Enter an expression to define new column:"), value = "", @@ -129,6 +132,9 @@ 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 9c78e73c..d3f95eb5 100644 --- a/R/cut-variable-dates.R +++ b/R/cut-variable-dates.R @@ -1,3 +1,9 @@ +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" @@ -206,9 +212,9 @@ cut_variable_ui <- function(id) { shiny::fluidRow( column( width = 3, - shinyWidgets::virtualSelectInput( + virtualSelectInput( inputId = ns("variable"), - label = datamods:::i18n("Variable to cut:"), + label = i18n("Variable to cut:"), choices = NULL, width = "100%" ) @@ -221,7 +227,7 @@ cut_variable_ui <- function(id) { width = 3, numericInput( inputId = ns("n_breaks"), - label = datamods:::i18n("Number of breaks:"), + label = i18n("Number of breaks:"), value = 3, min = 2, max = 12, @@ -232,12 +238,12 @@ cut_variable_ui <- function(id) { width = 3, checkboxInput( inputId = ns("right"), - label = datamods:::i18n("Close intervals on the right"), + label = i18n("Close intervals on the right"), value = TRUE ), checkboxInput( inputId = ns("include_lowest"), - label = datamods:::i18n("Include lowest value"), + label = i18n("Include lowest value"), value = TRUE ) ) @@ -248,10 +254,10 @@ cut_variable_ui <- function(id) { uiOutput(outputId = ns("slider_fixed")) ), plotOutput(outputId = ns("plot"), width = "100%", height = "270px"), - toastui::datagridOutput2(outputId = ns("count")), + datagridOutput2(outputId = ns("count")), actionButton( inputId = ns("create"), - label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")), + label = tagList(ph("scissors"), i18n("Create factor variable")), class = "btn-outline-primary float-end" ), tags$div(class = "clearfix") @@ -282,7 +288,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] - shinyWidgets::updateVirtualSelect( + updateVirtualSelect( inputId = "variable", choices = vars_num, selected = if (isTruthy(input$variable)) input$variable else vars_num[1] @@ -319,9 +325,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } - shinyWidgets::noUiSliderInput( + noUiSliderInput( inputId = session$ns("fixed_brks"), - label = datamods:::i18n("Fixed breaks:"), + label = i18n("Fixed breaks:"), min = lower, max = upper, value = brks, @@ -376,7 +382,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { shinyWidgets::virtualSelectInput( inputId = session$ns("method"), - label = datamods:::i18n("Method:"), + label = i18n("Method:"), choices = choices, selected = NULL, width = "100%" @@ -519,7 +525,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data }) - output$count <- toastui::renderDatagrid2({ + output$count <- renderDatagrid2({ # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) @@ -535,14 +541,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { datamods:::apply_grid_theme() } on.exit(toastui::reset_grid_theme()) - grid <- toastui::datagrid( + grid <- datagrid( data = count_data, colwidths = "guess", theme = "default", bodyHeight = "auto" ) grid <- toastui::grid_columns(grid, className = "font-monospace") - toastui::grid_colorbar( + grid_colorbar( grid, column = "count", label_outside = TRUE, @@ -570,7 +576,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { #' #' @rdname cut-variable modal_cut_variable <- function(id, - title = datamods:::i18n("Convert Numeric to Factor"), + title = i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL) { diff --git a/R/data_plots.R b/R/data_plots.R index 1b07f43b..8401bf87 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -681,7 +681,6 @@ 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 8d898f77..1a250d77 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 <- 500 + options$height <- 550 options$minBodyHeight <- 400 options$data <- data options$theme <- "default" diff --git a/R/helpers.R b/R/helpers.R index 73129194..377badb5 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -652,17 +652,3 @@ 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 596d4e21..5feb2555 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.5.4-250510' +hosted_version <- function()'v25.5.2-250508' diff --git a/R/plot_euler.R b/R/plot_euler.R index 10156b74..4dff9de5 100644 --- a/R/plot_euler.R +++ b/R/plot_euler.R @@ -87,11 +87,10 @@ 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 deac70c0..84ead0da 100644 --- a/R/plot_hbar.R +++ b/R/plot_hbar.R @@ -62,8 +62,9 @@ vertical_stacked_bars <- function(data, contrast_cut <- sum(contrast_text(colors, threshold = .3) == "white") - score_label <- data |> get_label(var = score) - group_label <- data |> get_label(var = group) + 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")) + p |> (\(.x){ diff --git a/R/plot_sankey.R b/R/plot_sankey.R index c45d46f2..473e7b77 100644 --- a/R/plot_sankey.R +++ b/R/plot_sankey.R @@ -119,6 +119,7 @@ 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) @@ -131,6 +132,8 @@ 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" @@ -194,8 +197,6 @@ 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 new file mode 100644 index 00000000..e69de29b diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index 9499e7d3..8857e5f0 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -200,12 +200,9 @@ 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)) { @@ -231,7 +228,7 @@ m_redcap_readServer <- function(id) { status = "success", include_data_alert( see_data_text = "Click to see data dictionary", - dataIdName = "see_dd", + dataIdName = "see_data", extra = tags$p( tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), glue::glue("The {data_rv$info$project_title} project is loaded.") @@ -257,8 +254,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_dd, { - show_data( + shiny::observeEvent(input$see_data, { + datamods::show_data( purrr::pluck(data_rv$dd_list, "data"), title = "Data dictionary", type = "modal", @@ -267,17 +264,6 @@ 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) @@ -392,24 +378,13 @@ m_redcap_readServer <- function(id) { imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) }) - 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) - ) - ), + code <- rlang::call2("read_redcap_tables", + !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , .ns = "REDCapCAST" ) + # browser() + if (inherits(imported, "try-error") || NROW(imported) < 1) { data_rv$data_status <- "error" data_rv$data_list <- NULL @@ -478,17 +453,9 @@ 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 - # ), - 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 + tags$p( + tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + data_rv$data_message ) ) } else { diff --git a/R/regression_model.R b/R/regression_model.R index df79cc16..252cbf16 100644 --- a/R/regression_model.R +++ b/R/regression_model.R @@ -271,13 +271,12 @@ 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 (l_unique < 2) { + } else if (length(unique(data)) < 2) { out <- "monotone" - } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) { - if (identical("logical", cl_d) | l_unique == 2) { + } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) { + if (identical("logical", cl_d) | length(unique(data)) == 2) { out <- "dichotomous" } else { # if (is.ordered(data)) { @@ -290,7 +289,7 @@ data_type <- function(data) { out <- "text" } else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) { out <- "datetime" - } else if (l_unique > 2) { + } else if (!length(unique(data)) == 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 080cfc43..57d54ffe 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 3fd4719e..a3943495 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, - shinyWidgets::virtualSelectInput( + virtualSelectInput( inputId = ns("variable"), label = i18n("Factor variable to reorder:"), choices = NULL, @@ -66,10 +66,10 @@ update_factor_ui <- function(id) { ) ) ), - toastui::datagridOutput(ns("grid")), + datagridOutput(ns("grid")), tags$div( class = "float-end", - shinyWidgets::prettyCheckbox( + 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 dbc64f8a..eb20a11a 100644 --- a/R/update-variables-ext.R +++ b/R/update-variables-ext.R @@ -1,3 +1,7 @@ +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 66297f9b..99d8d012 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://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. +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. -[***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). +[***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. 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 dc20f495..da151864 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-10 | +|date |2025-05-08 | |rstudio |2024.12.1+563 Kousa Dogwood (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | -|quarto |1.7.30 @ /usr/local/bin/quarto | -|FreesearchR |25.5.4.250510 | +|quarto |1.6.40 @ /usr/local/bin/quarto | +|FreesearchR |25.5.2.250508 | -------------------------------------------------------------------------------- @@ -44,6 +44,7 @@ |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) | @@ -58,7 +59,6 @@ |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,11 +66,8 @@ |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) | @@ -88,7 +85,6 @@ |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) | @@ -105,6 +101,7 @@ |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) | @@ -113,8 +110,6 @@ |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) | @@ -127,8 +122,6 @@ |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) | @@ -146,7 +139,6 @@ |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) | @@ -160,23 +152,16 @@ |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 7391d304..47ca9e1b 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 7dff7246..e9886d65 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,44 +1,5 @@ -######## -#### 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 ######## @@ -49,7 +10,7 @@ library(rlang) #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'25.5.3' +app_version <- function()'25.5.2' ######## @@ -168,6 +129,7 @@ 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', @@ -361,17 +323,20 @@ 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) - htmltools::tagList( + tagList( # datamods:::html_dependency_datamods(), # html_dependency_FreesearchR(), - shiny::tags$head( - shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + tags$head( + tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") ), # tags$head( # # Note the wrapping of the string in HTML() @@ -425,7 +390,7 @@ create_column_ui <- function(id) { ) ) ), - shiny::textAreaInput( + textAreaInput( inputId = ns("expression"), label = i18n("Enter an expression to define new column:"), value = "", @@ -473,6 +438,9 @@ 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()) { @@ -979,6 +947,12 @@ 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" @@ -1187,9 +1161,9 @@ cut_variable_ui <- function(id) { shiny::fluidRow( column( width = 3, - shinyWidgets::virtualSelectInput( + virtualSelectInput( inputId = ns("variable"), - label = datamods:::i18n("Variable to cut:"), + label = i18n("Variable to cut:"), choices = NULL, width = "100%" ) @@ -1202,7 +1176,7 @@ cut_variable_ui <- function(id) { width = 3, numericInput( inputId = ns("n_breaks"), - label = datamods:::i18n("Number of breaks:"), + label = i18n("Number of breaks:"), value = 3, min = 2, max = 12, @@ -1213,12 +1187,12 @@ cut_variable_ui <- function(id) { width = 3, checkboxInput( inputId = ns("right"), - label = datamods:::i18n("Close intervals on the right"), + label = i18n("Close intervals on the right"), value = TRUE ), checkboxInput( inputId = ns("include_lowest"), - label = datamods:::i18n("Include lowest value"), + label = i18n("Include lowest value"), value = TRUE ) ) @@ -1229,10 +1203,10 @@ cut_variable_ui <- function(id) { uiOutput(outputId = ns("slider_fixed")) ), plotOutput(outputId = ns("plot"), width = "100%", height = "270px"), - toastui::datagridOutput2(outputId = ns("count")), + datagridOutput2(outputId = ns("count")), actionButton( inputId = ns("create"), - label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")), + label = tagList(ph("scissors"), i18n("Create factor variable")), class = "btn-outline-primary float-end" ), tags$div(class = "clearfix") @@ -1263,7 +1237,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] - shinyWidgets::updateVirtualSelect( + updateVirtualSelect( inputId = "variable", choices = vars_num, selected = if (isTruthy(input$variable)) input$variable else vars_num[1] @@ -1300,9 +1274,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } - shinyWidgets::noUiSliderInput( + noUiSliderInput( inputId = session$ns("fixed_brks"), - label = datamods:::i18n("Fixed breaks:"), + label = i18n("Fixed breaks:"), min = lower, max = upper, value = brks, @@ -1357,7 +1331,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { shinyWidgets::virtualSelectInput( inputId = session$ns("method"), - label = datamods:::i18n("Method:"), + label = i18n("Method:"), choices = choices, selected = NULL, width = "100%" @@ -1500,7 +1474,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data }) - output$count <- toastui::renderDatagrid2({ + output$count <- renderDatagrid2({ # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) @@ -1516,14 +1490,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { datamods:::apply_grid_theme() } on.exit(toastui::reset_grid_theme()) - grid <- toastui::datagrid( + grid <- datagrid( data = count_data, colwidths = "guess", theme = "default", bodyHeight = "auto" ) grid <- toastui::grid_columns(grid, className = "font-monospace") - toastui::grid_colorbar( + grid_colorbar( grid, column = "count", label_outside = TRUE, @@ -1551,7 +1525,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { #' #' @rdname cut-variable modal_cut_variable <- function(id, - title = datamods:::i18n("Convert Numeric to Factor"), + title = i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL) { @@ -2281,7 +2255,6 @@ 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 @@ -3010,7 +2983,7 @@ show_data <- function(data, if (is.null(options)) options <- list() - options$height <- 500 + options$height <- 550 options$minBodyHeight <- 400 options$data <- data options$theme <- "default" @@ -3978,25 +3951,11 @@ 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.3-250510' +hosted_version <- function()'v25.5.2-250508' ######## @@ -4834,11 +4793,10 @@ 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") } @@ -4950,8 +4908,9 @@ vertical_stacked_bars <- function(data, contrast_cut <- sum(contrast_text(colors, threshold = .3) == "white") - score_label <- data |> get_label(var = score) - group_label <- data |> get_label(var = group) + 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")) + p |> (\(.x){ @@ -5141,6 +5100,7 @@ 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) @@ -5153,6 +5113,8 @@ 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" @@ -5216,8 +5178,6 @@ 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", @@ -5606,12 +5566,9 @@ 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)) { @@ -5637,7 +5594,7 @@ m_redcap_readServer <- function(id) { status = "success", include_data_alert( see_data_text = "Click to see data dictionary", - dataIdName = "see_dd", + dataIdName = "see_data", extra = tags$p( tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), glue::glue("The {data_rv$info$project_title} project is loaded.") @@ -5663,8 +5620,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_dd, { - show_data( + shiny::observeEvent(input$see_data, { + datamods::show_data( purrr::pluck(data_rv$dd_list, "data"), title = "Data dictionary", type = "modal", @@ -5673,17 +5630,6 @@ 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) @@ -5798,24 +5744,13 @@ m_redcap_readServer <- function(id) { imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) }) - 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) - ) - ), + code <- rlang::call2("read_redcap_tables", + !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , .ns = "REDCapCAST" ) + # browser() + if (inherits(imported, "try-error") || NROW(imported) < 1) { data_rv$data_status <- "error" data_rv$data_list <- NULL @@ -5884,17 +5819,9 @@ 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 - # ), - 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 + tags$p( + tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + data_rv$data_message ) ) } else { @@ -6095,6 +6022,13 @@ redcap_demo_app <- function() { } +######## +#### Current file: /Users/au301842/FreesearchR/R//redcap.R +######## + + + + ######## #### Current file: /Users/au301842/FreesearchR/R//regression_model.R ######## @@ -6372,13 +6306,12 @@ 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 (l_unique < 2) { + } else if (length(unique(data)) < 2) { out <- "monotone" - } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) { - if (identical("logical", cl_d) | l_unique == 2) { + } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) { + if (identical("logical", cl_d) | length(unique(data)) == 2) { out <- "dichotomous" } else { # if (is.ordered(data)) { @@ -6391,7 +6324,7 @@ data_type <- function(data) { out <- "text" } else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) { out <- "datetime" - } else if (l_unique > 2) { + } else if (!length(unique(data)) == 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) & @@ -8066,7 +7999,7 @@ update_factor_ui <- function(id) { fluidRow( column( width = 6, - shinyWidgets::virtualSelectInput( + virtualSelectInput( inputId = ns("variable"), label = i18n("Factor variable to reorder:"), choices = NULL, @@ -8101,10 +8034,10 @@ update_factor_ui <- function(id) { ) ) ), - toastui::datagridOutput(ns("grid")), + datagridOutput(ns("grid")), tags$div( class = "float-end", - shinyWidgets::prettyCheckbox( + prettyCheckbox( inputId = ns("new_var"), label = i18n("Create a new variable (otherwise replaces the one selected)"), value = FALSE, @@ -8330,6 +8263,10 @@ 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()]. @@ -9380,10 +9317,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(), @@ -9392,8 +9329,13 @@ 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, @@ -9406,17 +9348,12 @@ ui_elements <- list( color = datamods:::get_primary_color() ), shiny::helpText("Exclude variables with completeness below the specified percentage."), - shiny::br() - ), - shiny::column( - width = 6, - shiny::p("Specify manually:"), + shiny::br(), shiny::br(), shiny::uiOutput(outputId = "import_var"), - shiny::br() + shiny::uiOutput(outputId = "data_info_import", inline = TRUE) ) - ), - shiny::uiOutput(outputId = "data_info_import", inline = TRUE) + ) ), shiny::br(), shiny::br(), @@ -9893,7 +9830,33 @@ 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) @@ -9901,8 +9864,8 @@ data(trial) load_data <- function() { Sys.sleep(1) - shinyjs::hide("loading_page") - shinyjs::show("main_content") + hide("loading_page") + show("main_content") } @@ -9983,14 +9946,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 67a125cd..6403fa7f 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 = datamods:::i18n("Convert Numeric to Factor"), + title = i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL diff --git a/man/get_label.Rd b/man/get_label.Rd index c4484304..59643d65 100644 --- a/man/get_label.Rd +++ b/man/get_label.Rd @@ -22,6 +22,5 @@ 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 83742a75..6b2e7888 100644 --- a/man/plot_sankey_single.Rd +++ b/man/plot_sankey_single.Rd @@ -39,5 +39,6 @@ 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 deleted file mode 100644 index f79ba9a4..00000000 --- a/man/simple_snake.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% 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() -}