diff --git a/CITATION.cff b/CITATION.cff index 25ca71c..f026dad 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.3 +version: 25.5.4 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index be82a04..5a9123e 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.3 +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/NEWS.md b/NEWS.md index 9c02423..5f097c1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,13 @@ +# 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 diff --git a/R/app_version.R b/R/app_version.R index ba85500..5e843a2 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.5.3' +app_version <- function()'25.5.4' diff --git a/R/contrast_text.R b/R/contrast_text.R index 9ea4c5b..1db2e56 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 9bb71c4..0bc2402 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 d3f95eb..9c78e73 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 8401bf8..1b07f43 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/hosted_version.R b/R/hosted_version.R index 9f191af..596d4e2 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.5.3-250510' +hosted_version <- function()'v25.5.4-250510' diff --git a/R/plot_hbar.R b/R/plot_hbar.R index 84ead0d..deac70c 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 473e7b7..c45d46f 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/regression_model.R b/R/regression_model.R index 252cbf1..df79cc1 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 1717693..080cfc4 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 a394349..3fd4719 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 eb20a11..dbc64f8 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/SESSION.md b/SESSION.md index 583ed1c..dc20f49 100644 --- a/SESSION.md +++ b/SESSION.md @@ -15,7 +15,7 @@ |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.3.250510 | +|FreesearchR |25.5.4.250510 | -------------------------------------------------------------------------------- @@ -38,14 +38,12 @@ |cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) | -|checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) | |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | |cli |3.6.5 |2025-04-23 |CRAN (R 4.4.1) | |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) | @@ -60,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) | @@ -67,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) | @@ -78,7 +80,6 @@ |htmltools |0.5.8.1 |2024-04-04 |CRAN (R 4.4.1) | |htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) | |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | -|httr |1.4.7 |2023-08-15 |CRAN (R 4.4.0) | |IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | |insight |1.2.0 |2025-04-22 |CRAN (R 4.4.1) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) | @@ -87,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) | @@ -111,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) | @@ -123,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) | @@ -156,15 +162,21 @@ |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/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 34302d2..7dff724 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 @@ -3969,7 +3996,7 @@ simple_snake <- function(data){ #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.5.2-250510' +hosted_version <- function()'v25.5.3-250510' ######## @@ -4807,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") } @@ -4922,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){ @@ -5114,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) @@ -5127,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" @@ -5192,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", @@ -6346,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)) { @@ -6364,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) & @@ -8039,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, @@ -8074,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, @@ -8303,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()]. @@ -9870,35 +9893,7 @@ ui <- bslib::page_fixed( #### Current file: /Users/au301842/FreesearchR/app/server.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) + data(starwars) data(mtcars)