From 59cefc55a313835dd5069d6897d462b9ae330f20 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 30 Oct 2025 12:55:49 +0100 Subject: [PATCH 01/12] feat: Frequncy column added to new factor overview --- R/cut-variable-ext.R | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/R/cut-variable-ext.R b/R/cut-variable-ext.R index 65ff214a..356a2ba2 100644 --- a/R/cut-variable-ext.R +++ b/R/cut-variable-ext.R @@ -214,13 +214,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { choices <- unique(choices) - ## Implement labeled vector selection of cut methods to include descriptions - ## - ## cut_methods() - ## - - - vectorSelectInput( inputId = ns("method"), label = i18n$t("Method:"), @@ -388,6 +381,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) + count_data <- as.data.frame( table( breaks = data[[length(data)]], @@ -395,6 +389,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ), responseName = "count" ) + count_data$freq <- paste(signif(count_data$count/nrow(data)*100,3),"%") + # browser() gridTheme <- getOption("datagrid.theme") if (length(gridTheme) < 1) { datamods:::apply_grid_theme() From 48f4d99429206c1d8f0bc43590d14df90b001c3c Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 30 Oct 2025 14:49:38 +0100 Subject: [PATCH 02/12] feat: new string split function to allow splitting string into rows or columns. select from allowed delimiters. --- R/separate_string.R | 289 +++++++++++++++++++++++++++++++++++ R/ui_elements.R | 20 ++- examples/string_split_demo.R | 54 +++++++ man/detect_delimiter.Rd | 22 +++ man/separate_string.Rd | 23 +++ 5 files changed, 404 insertions(+), 4 deletions(-) create mode 100644 R/separate_string.R create mode 100644 examples/string_split_demo.R create mode 100644 man/detect_delimiter.Rd create mode 100644 man/separate_string.Rd diff --git a/R/separate_string.R b/R/separate_string.R new file mode 100644 index 00000000..d319272d --- /dev/null +++ b/R/separate_string.R @@ -0,0 +1,289 @@ +string_split_ui <- function(id) { + ns <- NS(id) + tagList( + shiny::fluidRow( + column( + width = 4, + shiny::uiOutput(outputId = ns("variable")) + ), + column( + width = 4, + shiny::uiOutput(outputId = ns("delim")) + ), + column( + width = 4, + shiny::uiOutput(outputId = ns("direction")) + )#, + # column( + # width = 3, + # actionButton( + # inputId = ns("split"), + # label = tagList(phosphoricons::ph("scissors"), i18n$t("Split the variable")), + # class = "btn-outline-primary float-end" + # ) + # ) + ), + shiny::fluidRow( + column( + width = 3, + shiny::h4(i18n$t("Original data")), + shiny::tableOutput(outputId = ns("orig_data")) + ), + column(width=1), + column( + width = 8, + shiny::h4(i18n$t("Preview of result")), + shiny::tableOutput(outputId = ns("new_data")) + ) + ), + actionButton( + inputId = ns("create"), + label = tagList(phosphoricons::ph("pencil"), i18n$t("Save new data")), + class = "btn-outline-primary float-end" + ), + tags$div(class = "clearfix") + ) +} + + + +string_split_server <- function(id, data_r = reactive(NULL)) { + moduleServer( + id, + function(input, output, session) { + rv <- reactiveValues(data = NULL, temp = NULL, out = NULL) + + ns <- session$ns + + bindEvent(observe({ + data <- data_r() + rv$data <- data + # browser() + vars_num <- vapply(data, \(.x){ + is.character(.x) + }, logical(1)) + vars_num <- names(vars_num)[vars_num] + + output$variable <- shiny::renderUI( + columnSelectInput( + inputId = ns("variable"), + data = data, + label = i18n$t("Variable to split:"), + width = "100%", + col_subset = vars_num, + selected = if (isTruthy(input$variable)) input$variable else vars_num[1] + ) + ) + + # shinyWidgets::updateVirtualSelect( + # inputId = "variable", + # choices = vars_num, + # selected = if (isTruthy(input$variable)) input$variable else vars_num[1] + # ) + }), data_r(), input$hidden) + + output$delim <- shiny::renderUI({ + req(rv$data) + req(input$variable) + # browser() + + data <- rv$data |> + dplyr::select(tidyselect::all_of(input$variable)) + + delimiters <- Reduce(c, unique(sapply(data[[1]], detect_delimiter))) + + # shiny::textInput(inputId = ns("delim"), label = i18n$t("Text or character to split string by")) + shiny::selectInput( + inputId = ns("delim"), label = i18n$t("Select delimiter"), + choices = setNames( + delimiters, + glue::glue("'{delimiters}'") + ),selected = 1 + ) + }) + + + output$direction <- shiny::renderUI({ + vectorSelectInput( + inputId = ns("direction"), + label = i18n$t("Direction:"), + choices = setNames( + c( + "wide", + "long" + ), + c( + i18n$t("Split string to multiple columns. Keep number of rows."), + i18n$t("Split string to multiple observations (rows) in the same column. Also ads id and instance columns") + ) + ), + selected = "wide", + width = "100%" + ) + }) + + observeEvent( + list( + input$variable, + input$delim, + input$direction + ), + { + req(rv$data) + req(input$variable) + req(input$delim) + req(input$direction) + + data <- rv$data |> + dplyr::select(tidyselect::all_of(input$variable)) + # browser() + rv$temp <- separate_string( + data = data, + col = input$variable, + delim = input$delim, + direction = input$direction + ) + } + ) + + shiny::observeEvent(input$split, { + show_data(rv$temp, title = i18n$t("Browse data preview"), type = "modal") + }) + + ## Toastui would not render the original data, so the solution was to go + ## with native table rendering, which works, but doesn't please the eye + + output$orig_data <- shiny::renderTable({ + req(data_r()) + req(input$variable) + data <- data_r()|> + dplyr::select(tidyselect::all_of(input$variable)) + # browser() + head(data , 10) + }) + + output$new_data <- shiny::renderTable({ + shiny::req(rv$temp) + data <- rv$temp + head(data, 10) + # toastui::datagrid( + # data = head(data, 100), + # colwidths = "guess", + # theme = "default", + # bodyHeight = "auto", pagination = 10 + # ) + }) + + data_split_r <- reactive({ + req(rv$temp) + + data <- rv$data + + separate_string( + data = data, + col = input$variable, + delim = input$delim, + direction = input$direction + ) + }) + + data_returned_r <- observeEvent(input$create, { + rv$data <- data_split_r() + }) + + return(reactive(rv$data)) + } + ) +} + + +modal_string_split <- function(id, + title = i18n$t("Split character string"), + easyClose = TRUE, + size = "xl", + footer = NULL) { + ns <- NS(id) + showModal(modalDialog( + title = tagList(title, datamods:::button_close_modal()), + string_split_ui(id), + tags$div( + style = "display: none;", + textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) + ), + easyClose = easyClose, + size = size, + footer = footer + )) +} + + +### Helpers + +#' Separate string wide or long +#' +#' @param data data +#' @param col column +#' @param delim delimiter +#' @param direction target direction +#' +#' @returns data.frame +#' @export +#' +separate_string <- function(data, col, delim, direction = c("wide", "long")) { + direction <- match.arg(direction) + + if (direction == "long") { + out <- data |> + dplyr::mutate(id_str_split = dplyr::row_number()) |> + dplyr::group_by_at("id_str_split") |> + tidyr::separate_longer_delim(cols = tidyselect::all_of(col), delim = delim) |> + dplyr::mutate(instance_str_split = dplyr::row_number()) |> + # add_instance(by="id") + dplyr::ungroup() |> + dplyr::mutate(dplyr::across(tidyselect::matches(col), trimws)) + } else if (direction == "wide") { + ## Experiment of wide to long + + out <- data |> + tidyr::separate_wider_delim( + cols = tidyselect::all_of(col), + delim = delim, + names_sep = "_", + too_few = "align_start" + ) |> + dplyr::mutate(dplyr::across(tidyselect::starts_with(col), trimws)) + } + + out +} + + + +#' Detect delimiters in string based on allowed delimiters +#' +#' @description +#' Accepts any repeat of delimiters and includes surrounding whitespace +#' +#' +#' @param text character vector +#' @param delimiters allowed delimiters +#' +#' @returns character vector +#' @export +#' +#' @examples +#' sapply(c("Walk - run", "Sel__Re", "what;now"), detect_delimiter) +detect_delimiter <- function(data, delimiters = c("_", "-", ";", "\n",",")) { + # Create patterns for each delimiter with potential surrounding whitespace + patterns <- paste0("\\s*\\", delimiters, "+\\s*") + + # Check each pattern + out <- sapply(patterns, \(.x){ + if (grepl(.x, data)) { + # Extract the actual matched delimiter with whitespace + regmatches(data, regexpr(.x, data)) + } + }) + + Reduce(c, out) +} diff --git a/R/ui_elements.R b/R/ui_elements.R index f216beee..3d23d3a2 100644 --- a/R/ui_elements.R +++ b/R/ui_elements.R @@ -99,7 +99,7 @@ ui_elements <- function(selection) { import_globalenv_ui( id = "env", title = NULL, - packages = c("NHANES", "stRoke", "datasets") + packages = c("NHANES", "stRoke", "datasets", "MASS") ) ), # shiny::conditionalPanel( @@ -268,7 +268,7 @@ ui_elements <- function(selection) { shiny::tags$br(), shiny::fluidRow( shiny::column( - width = 4, + width = 3, shiny::actionButton( inputId = "modal_update", label = i18n$t("Reorder factor levels"), @@ -280,7 +280,7 @@ ui_elements <- function(selection) { shiny::tags$br() ), shiny::column( - width = 4, + width = 3, shiny::actionButton( inputId = "modal_cut", label = i18n$t("New factor"), @@ -292,7 +292,19 @@ ui_elements <- function(selection) { shiny::tags$br() ), shiny::column( - width = 4, + width = 3, + shiny::actionButton( + inputId = "modal_string", + label = i18n$t("Split text"), + width = "100%" + ), + shiny::tags$br(), + shiny::helpText(i18n$t("Split a text column by a custom delimiter.")), + shiny::tags$br(), + shiny::tags$br() + ), + shiny::column( + width = 3, shiny::actionButton( inputId = "modal_column", label = i18n$t("New variable"), diff --git a/examples/string_split_demo.R b/examples/string_split_demo.R new file mode 100644 index 00000000..dd70f5a1 --- /dev/null +++ b/examples/string_split_demo.R @@ -0,0 +1,54 @@ +library(shiny) +library(reactable) + +ui <- fluidPage( + theme = bslib::bs_theme(version = 5L, preset = "bootstrap"), + shinyWidgets::html_dependency_winbox(), + tags$h2("Split string"), + fluidRow( + column( + width = 4, + actionButton("modal", "Or click here to open a modal to create a column") + ), + column( + width = 8, + reactableOutput(outputId = "table"), + verbatimTextOutput("code") + ) + ) +) + +server <- function(input, output, session) { + rv <- reactiveValues( + data = MASS::Cars93[, c(1, 3, 4, 5, 6, 10)], + out = NULL + ) + + # modal window mode + observeEvent(input$modal, modal_string_split("modal")) + + rv$out <- create_column_server( + id = "modal", + data_r = reactive(rv$data) + ) + + + # Show result + output$table <- renderReactable({ + data <- req(rv$data) + reactable( + data = data, + bordered = TRUE, + compact = TRUE, + striped = TRUE + ) + }) + + output$code <- renderPrint({ + attr(rv$data, "code") + }) +} + +if (interactive()) { + shinyApp(ui, server) +} diff --git a/man/detect_delimiter.Rd b/man/detect_delimiter.Rd new file mode 100644 index 00000000..2c5f69b7 --- /dev/null +++ b/man/detect_delimiter.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/separate_string.R +\name{detect_delimiter} +\alias{detect_delimiter} +\title{Detect delimiters in string based on allowed delimiters} +\usage{ +detect_delimiter(data, delimiters = c("_", "-", ";", "\\n", ",")) +} +\arguments{ +\item{delimiters}{allowed delimiters} + +\item{text}{character vector} +} +\value{ +character vector +} +\description{ +Accepts any repeat of delimiters and includes surrounding whitespace +} +\examples{ +sapply(c("Walk - run", "Sel__Re", "what;now"), detect_delimiter) +} diff --git a/man/separate_string.Rd b/man/separate_string.Rd new file mode 100644 index 00000000..9c9b6f24 --- /dev/null +++ b/man/separate_string.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/separate_string.R +\name{separate_string} +\alias{separate_string} +\title{Separate string wide or long} +\usage{ +separate_string(data, col, delim, direction = c("wide", "long")) +} +\arguments{ +\item{data}{data} + +\item{col}{column} + +\item{delim}{delimiter} + +\item{direction}{target direction} +} +\value{ +data.frame +} +\description{ +Separate string wide or long +} From 901864acff32c89b6afa3aaef4282b4af0b45fa7 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 30 Oct 2025 20:50:50 +0100 Subject: [PATCH 03/12] adjusted split function --- R/separate_string.R | 128 ++++++++++++++++++++++++++++++++++++------- R/ui_elements.R | 2 +- man/is_splittable.Rd | 21 +++++++ 3 files changed, 129 insertions(+), 22 deletions(-) create mode 100644 man/is_splittable.Rd diff --git a/R/separate_string.R b/R/separate_string.R index d319272d..38a243bb 100644 --- a/R/separate_string.R +++ b/R/separate_string.R @@ -2,6 +2,7 @@ string_split_ui <- function(id) { ns <- NS(id) tagList( shiny::fluidRow( + # shiny::textOutput(outputId = ns("no_splits")), column( width = 4, shiny::uiOutput(outputId = ns("variable")) @@ -13,7 +14,7 @@ string_split_ui <- function(id) { column( width = 4, shiny::uiOutput(outputId = ns("direction")) - )#, + ) # , # column( # width = 3, # actionButton( @@ -28,8 +29,10 @@ string_split_ui <- function(id) { width = 3, shiny::h4(i18n$t("Original data")), shiny::tableOutput(outputId = ns("orig_data")) + # This doesn't render... + # toastui::datagridOutput2(outputId = ns("orig_data_2")) ), - column(width=1), + column(width = 1), column( width = 8, shiny::h4(i18n$t("Preview of result")), @@ -38,7 +41,7 @@ string_split_ui <- function(id) { ), actionButton( inputId = ns("create"), - label = tagList(phosphoricons::ph("pencil"), i18n$t("Save new data")), + label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")), class = "btn-outline-primary float-end" ), tags$div(class = "clearfix") @@ -51,16 +54,29 @@ string_split_server <- function(id, data_r = reactive(NULL)) { moduleServer( id, function(input, output, session) { - rv <- reactiveValues(data = NULL, temp = NULL, out = NULL) + rv <- reactiveValues(data = NULL, temp = NULL, out=NULL) ns <- session$ns - bindEvent(observe({ + # output$no_splits <- shiny::renderText({ + # req({ + # data_r() + # }) + # + # if (any(is_splittable(data_r()))) { + # i18n$t("No character variables with accepted delimiters detected.") + # } + # }) + + shiny::observe({ + req(data_r()) + + # if (any(is_splittable(data_r()))) { data <- data_r() rv$data <- data - # browser() + vars_num <- vapply(data, \(.x){ - is.character(.x) + is_splittable(.x) }, logical(1)) vars_num <- names(vars_num)[vars_num] @@ -74,19 +90,23 @@ string_split_server <- function(id, data_r = reactive(NULL)) { selected = if (isTruthy(input$variable)) input$variable else vars_num[1] ) ) - + # } # shinyWidgets::updateVirtualSelect( # inputId = "variable", # choices = vars_num, # selected = if (isTruthy(input$variable)) input$variable else vars_num[1] # ) - }), data_r(), input$hidden) + }) output$delim <- shiny::renderUI({ req(rv$data) req(input$variable) # browser() + # req({ + # any(apply(data_r(),2,is_splittable)) + # }) + # if (any(is_splittable(data_r()))) { data <- rv$data |> dplyr::select(tidyselect::all_of(input$variable)) @@ -98,12 +118,18 @@ string_split_server <- function(id, data_r = reactive(NULL)) { choices = setNames( delimiters, glue::glue("'{delimiters}'") - ),selected = 1 + ), selected = 1 ) + # } }) output$direction <- shiny::renderUI({ + # req({ + # rv$data + # }) + + # if (any(is_splittable(data_r()))) { vectorSelectInput( inputId = ns("direction"), label = i18n$t("Direction:"), @@ -120,6 +146,7 @@ string_split_server <- function(id, data_r = reactive(NULL)) { selected = "wide", width = "100%" ) + # } }) observeEvent( @@ -146,9 +173,9 @@ string_split_server <- function(id, data_r = reactive(NULL)) { } ) - shiny::observeEvent(input$split, { - show_data(rv$temp, title = i18n$t("Browse data preview"), type = "modal") - }) + # shiny::observeEvent(input$split, { + # show_data(rv$temp, title = i18n$t("Browse data preview"), type = "modal") + # }) ## Toastui would not render the original data, so the solution was to go ## with native table rendering, which works, but doesn't please the eye @@ -156,12 +183,23 @@ string_split_server <- function(id, data_r = reactive(NULL)) { output$orig_data <- shiny::renderTable({ req(data_r()) req(input$variable) - data <- data_r()|> + data <- data_r() |> dplyr::select(tidyselect::all_of(input$variable)) # browser() - head(data , 10) + head(data, 10) }) + # output$orig_data_2 <- toastui::renderDatagrid2({ + # req(data_r()) + # req(input$variable) + # data <- data_r() |> + # dplyr::select(tidyselect::all_of(input$variable)) + # # browser() + # toastui::datagrid(head(data, 10)) + # }) + + + output$new_data <- shiny::renderTable({ shiny::req(rv$temp) data <- rv$temp @@ -179,19 +217,40 @@ string_split_server <- function(id, data_r = reactive(NULL)) { data <- rv$data - separate_string( - data = data, + parameters <- list( col = input$variable, delim = input$delim, direction = input$direction ) - }) + + out <- tryCatch({ + rlang::exec(separate_string, !!!modifyList( + parameters, + list( + data = data + ) + )) + }) + # browser() + + # separate_string( + # data = data, + # + # ) + + code <- rlang::call2( + "separate_string", + !!!parameters, + .ns = "FreesearchR" + ) + attr(out, "code") <- code + out}) data_returned_r <- observeEvent(input$create, { - rv$data <- data_split_r() + rv$out <- data_split_r() }) - return(reactive(rv$data)) + return(reactive(rv$out)) } ) } @@ -273,7 +332,7 @@ separate_string <- function(data, col, delim, direction = c("wide", "long")) { #' #' @examples #' sapply(c("Walk - run", "Sel__Re", "what;now"), detect_delimiter) -detect_delimiter <- function(data, delimiters = c("_", "-", ";", "\n",",")) { +detect_delimiter <- function(data, delimiters = c("_", "-", ";", "\n", ",")) { # Create patterns for each delimiter with potential surrounding whitespace patterns <- paste0("\\s*\\", delimiters, "+\\s*") @@ -287,3 +346,30 @@ detect_delimiter <- function(data, delimiters = c("_", "-", ";", "\n",",")) { Reduce(c, out) } + + +#' Determine if any variable in data frame character and contains recognized delimiters +#' +#' @param data vector or data.frame +#' +#' @returns logical +#' @export +#' +#' @examples +#' any(apply(mtcars, 2, is_splittable)) +#' is_splittable(mtcars) +is_splittable <- function(data) { + if (is.data.frame(data)) { + return(apply(data, 2, is_splittable)) + } + + if (is.character(data)) { + if (length(Reduce(c, unique(sapply(data, detect_delimiter)))) > 0) { + TRUE + } else { + FALSE + } + } else { + FALSE + } +} diff --git a/R/ui_elements.R b/R/ui_elements.R index 3d23d3a2..48a18a6b 100644 --- a/R/ui_elements.R +++ b/R/ui_elements.R @@ -299,7 +299,7 @@ ui_elements <- function(selection) { width = "100%" ), shiny::tags$br(), - shiny::helpText(i18n$t("Split a text column by a custom delimiter.")), + shiny::helpText(i18n$t("Split a text column by a recognised delimiter.")), shiny::tags$br(), shiny::tags$br() ), diff --git a/man/is_splittable.Rd b/man/is_splittable.Rd new file mode 100644 index 00000000..f7aa8c69 --- /dev/null +++ b/man/is_splittable.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/separate_string.R +\name{is_splittable} +\alias{is_splittable} +\title{Determine if any variable in data frame character and contains recognized delimiters} +\usage{ +is_splittable(data) +} +\arguments{ +\item{data}{vector or data.frame} +} +\value{ +logical +} +\description{ +Determine if any variable in data frame character and contains recognized delimiters +} +\examples{ +any(apply(mtcars, 2, is_splittable)) +is_splittable(mtcars) +} From 5249c7c2c0483569dc60a0a4632824ec9276695f Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 30 Oct 2025 20:51:08 +0100 Subject: [PATCH 04/12] news updated --- CITATION.cff | 2 +- DESCRIPTION | 3 ++- NAMESPACE | 3 +++ NEWS.md | 4 ++++ R/app_version.R | 2 +- R/create-column-mod.R | 29 ----------------------------- R/hosted_version.R | 2 +- R/sysdata.rda | Bin 2815 -> 2762 bytes SESSION.md | 17 +++++------------ 9 files changed, 17 insertions(+), 45 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index c781a622..265698dc 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -8,7 +8,7 @@ message: 'To cite package "FreesearchR" in publications use:' type: software license: AGPL-3.0-or-later title: 'FreesearchR: Easy data analysis for clinicians' -version: 25.10.4 +version: 25.10.5 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index b90d1fef..1c3b44e8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: Easy data analysis for clinicians -Version: 25.10.4 +Version: 25.10.5 Authors@R: c( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), @@ -125,6 +125,7 @@ Collate: 'regression_plot.R' 'regression_table.R' 'report.R' + 'separate_string.R' 'syntax_highlight.R' 'theme.R' 'translate.R' diff --git a/NAMESPACE b/NAMESPACE index a0dca89e..1544994a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -48,6 +48,7 @@ export(data_visuals_server) export(data_visuals_ui) export(default_format_arguments) export(default_parsing) +export(detect_delimiter) export(drop_empty_event) export(expression_string) export(factorize) @@ -78,6 +79,7 @@ export(is_any_class) export(is_consecutive) export(is_datetime) export(is_identical_to_previous) +export(is_splittable) export(is_valid_redcap_url) export(is_valid_token) export(launch_FreesearchR) @@ -129,6 +131,7 @@ export(remove_nested_list) export(repeated_instruments) export(sankey_ready) export(selectInputIcon) +export(separate_string) export(set_column_label) export(show_data) export(simple_snake) diff --git a/NEWS.md b/NEWS.md index f906f159..5658b0c6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# FreesearchR 25.10.5 + +*NEW* New character/text split function available. A selection of delimiters are recognised and selectable. Function only available if splittable variables are present. This was the last big function to implement after workshops at Jitimai in Zanzibar. + # FreesearchR 25.10.4 *NEW* Two new options to create new simplified factors from factors. The "top" option will keep only the top N levels, while the "bottom" option will combine all levels occurring below set percentage. diff --git a/R/app_version.R b/R/app_version.R index 7ce777f9..d67b66a1 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.10.4' +app_version <- function()'25.10.5' diff --git a/R/create-column-mod.R b/R/create-column-mod.R index 9627b3ac..308e2c00 100644 --- a/R/create-column-mod.R +++ b/R/create-column-mod.R @@ -29,35 +29,6 @@ create_column_ui <- function(id) { 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() - # tags$style(HTML(" - # /* modified from esquisse for data types */ - # .btn-column-categorical { - # background-color: #EF562D; - # color: #FFFFFF; - # } - # .btn-column-continuous { - # background-color: #0C4C8A; - # color: #FFFFFF; - # } - # .btn-column-dichotomous { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-datetime { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-id { - # background-color: #848484; - # color: #FFFFFF; - # } - # .btn-column-text { - # background-color: #2E2E2E; - # color: #FFFFFF; - # }")) - # ), fluidRow( column( width = 6, diff --git a/R/hosted_version.R b/R/hosted_version.R index 9afbad44..b917069a 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.10.4-251027' +hosted_version <- function()'v25.10.5-251030' diff --git a/R/sysdata.rda b/R/sysdata.rda index 9c68c58f1b4f6793374c8a6749c90e8984559075..98908065c8d930ee00aeab5c6790a525bc694740 100644 GIT binary patch literal 2762 zcmV;*3N`gYT4*^jL0KkKSv7zGg8&)bf5iX)Xazw3|KNXb-@w2B|L{Nn00IaB;0#|D zAqzb~a4AU85)>aE008s=4-HH}6F?z|XhxYP(2=L9wM-_B01X~ViRgMzYI!sgl{7s~ znx~|~15E$`(W4*%kOqJn9B617G|1CNnE{D{00E#h2AKhYG6b4PiV|tDN$8$}8a+%+ zsfZ04Fe5<3zy#Ak%BQG3NsR<#*$jX~BWg4TBPIX@dT0QF5>Yih3V5fe8UsVrJw|{4 z007g}007B?Smq{jj9_LmP!`)lid_T&(ZQe za7=`j&=m}&+cT+le75TV7r|6VUL*L+y~+0fVf*GA|Gw{Je;>=sXt@2hAv!hsO=(qQ z`@i2SKNt;m$~RwardKU%RS6w@C_x9oPDgU?E-|!96kl>1)U7pfb8(cBVfbhTE)^=+ zPNoEHVV7EL2@dc~!G&ojks_+ffN;ZcBo7OprOC{CvN}J9Q}@5N@O1cd6t!gCdTzSy z2o7475qel=+!n@};It+&hQnbJ0ew`MTliosD>3L1U7 zj-JA!u@MmFXXfkeOc{MU=qe8E&5DksL{(K4WL1h0V!=U07DW^hf{P%kq(p)YQH)r{ z7$~a|BEevys;usL-5TG9apF%FB+_|Jl&g5-GkG+c!BE)k)!i$FMKr>`ETNoQ>w^wX zcR0~iO|a#}<(HluE;?{AK_+ilCa5kn&UMC}$P`iRLW#y1q|>C{Sl9E0cNCJC_w;7v}Ob{v`oyCYUZLTrzWoG!C5d2c_dQJ(tvkM8o7~+RgZ3}_8V~s zW<1KscZk$D!i8++=TdKbjX{c28>&h*4$hflb&S{Nqav)54Kk<}vmj2>I=w`&i-G)0+VpFC)5&g# zq9}nHny6$nlY5PkH7O7X2O88J7)}&0+-gh+)0>zsHY6AmEE7q}(qzTy&E8Du-WhZy zRWe9Kw2*+5=GKIbyNy(ulA0_X3@9B!2%XDwcc^B{QwbX~MH#HRnKVNqXD3QZ9K)l^ zJl@233p~GvcoqOA!8=}A#>l>^N1XyWkZLmFJ8 zb1*j~ATpRV#<>!SmWm@pwqq(RIwa{3xp9z5)aq+NGZxksFjz5=)y$UP@|eXL)d(=| z_wXTr!YaWK?y`3b>v9Gbtd>x)e|?!a)SRK($=~ns*7cT^7F$>NB}^k$mfkIM5U5ib z)3tY!=X5Q<2% zADXmFB3eX{SoPD(N_9J`Qp-{OObVi`NQg3N8(~$9HP=rX*%T4@ZFkclj1}cMW+o)Q zkAs7bEwy4T;ob&?7$QZ0q(m6W#h`AMBFIz{LJnAm5fm6<$A-h-ihz+ZTZTe7p+yo9 zMnDR}3o0QrV+)odbRk)$s(x&u<1JQhid$u0J;*ELOVpL0Ru?B7D#($dxo!AY`diW#jsXrpMhTCrsA?3?uOY4dhKgoekq znz5;&asebZ9{au+JJs1?Hu?}dYdLG{5pS`el+WDCjuqTU9&p%;1b|5q+#)7dek6g1 z(U7I7k^m$Ft!27VDtQ2sHU6sZH3C3G+;QQm$6V$E3z7nXWF;>T&D+0!pyT2CzPAZc9-tiO{g4EkYYr1YSgFQi=Ejqn$ z`6aqT?{L>OHaeB|P|7hK4&s4seU(ro6zM*NsKQ<;(OEJED{ev`lM1zlU*s%Tn42;%&{7oJiCoAXBezA?1MnIi zxpCZ=vILgSdTkCAX7`sX!3Y<9$D`sddLk z==5Zjem4e$n{?VOJ9M~O_wxD<$+)87!YM$q6&9Hr@!Pv&c9+ZhH+9_`h)&FV$J60m zBEk_D0+(XQYsE2n2R6X);%lMWk6x33Q-ayH@==z+NI4p>B%s(7o(1dN4ssgj2K8@o z&aSY*FVy*<>$7-|GgmK12tRZ><0}~P?;+XkHi_@Lx};(Qg`rbeAy}Xiy>MYQdL0f$ zZDIQ(V(auwAhBf>(vVTciMyL`QmK6wNaMBjx0UT= zE}Tm9nh~xI>hk2s342II@?wEtSWcpyPh?<1IuMM+VDs>9CBCx~;Vfh$Nle^nlNHJO zx$XWCcB>Vf7{i~`XbX+Prv<$6FTH2fMQ}n7FuSZu3Fk&dfb>CXIojjJ1{wb>wVvEHYFZc0�uKyp_rhWYx%&V3`zEN*LBVh(TNl$@3*vb~B&v z*`!hh*&b!!S4G%+3GlBLf-8*mFIfGiG8?4wFz0Ez${kn;=20bl)g>M$BJYIG(LUd< z+j+X%@)M<#p!;vi6`%{(oq|#!zvHRd7im~l7L7~_&5d%wQeqXwFv0u5Y|W!Bk?2lW z+Dd9ORybAGD04+w^Y&2E#bv5NJnQ7vBgj{B545iR#wTtddukiwj9Yy3SxSf2h)g9O zs%%h2nuu*GwjD7(JGdh%bDIe=4BrX~98ZIgae&a~iRdu(u3|Z|jq*xhOdE4sK7Up& zyDTzsWtFw6V=E{|o)w1Nxf=o3!JFkHPV13mDpe_uC53Q}yO*K?=cNC?HSI&JQ*HC|I)+A349 zDG?MZYxN`BV?36vH?1h?!d(@3xkL=vhUJd2e7NbW#|@qGsI1^-)$6XE!!3AEK7V8{ zhM8zAN_A4?YO{4T)qs`6yHjfLDGk+87*cydf5QL&Yz097|KNXb-@w2B|L{Nn1ONyD;0&J@ zAqxk9;Zl~$0z!iM;5`5+030S00x3hBqT*c^rxh0 zwFZD_G%)}JAOHXWXfmiW001-q004|km;e9(00@$VrpVev$YeI4XvhEn008wg3_u!P zEOHY_qdg3UIuhGy6-*Hj9%i)w0B`PKEI~%g2x9Pkc66rz4B*cHd$<3_K|QfdWR}pC z3(Or^*1@Hl4dM5}i;)=_LnRRE?Mr&|*> zPfu$M#aWpGgiZxA8?=;TkyT|daJYvjP)Advmv`SE4o7?awtNTT*9_x%M;sfoRrlR` z1C!PfcreUji(#`CAw7*Y8wi^!sHy+&<-=9k#K)2e-?VQeX_2P;F1)TH8AxtPN9h_7 zV7^6K&1)vw-Tnl>lpqTOl1I>6sq5PJVqwLO#FIgc%I974YFx8u-?gD+!#z6FeWr2b z@VzkM8S>)Agd+|C@CRI(hs!L?xknilbg!->CBw;gS%UHE*|y?JL~fwvk1uz@Z-t2m zfI+(8I7+&whDuR&!XmQfh~4iky3>=rm~a=J5mbehv{Z243AdE;6juqfXqbztWxc#x zys=_Bd3XA(+(9o3OYbzV4#qcz!!7*up3dyjsGK6S4XpRxVumOpYrzLX2!=jB4GZ~r zHRcdIa70s_D5$|i0zrWxAr%l=0ZND{q56u5@}MFGn-ZN3(A|)OAViFWk`R!Lgpv{} zq0abbI+;}*uoVrBt({)Hy8m9JL`Ou)ii}W%B$7!9BpD=%5k-Q6iveQ9MT)WrtcxO` ziXxzlSSm186j-1tf`Wp@6!Gl7WtrDGc2v4(l8n znHaTMQ@OWuxtMJQn6E1wUL#H(6f*X9=TdKbcwmUNPj;!c8~~a^=HTb$qay5(Pc-KT zSFYJN-r{t#H=~?7#7w<-I+7DGVhIGD3#P~-F;cdsT5z)Ig}S3B1aGG;O;hHe2rO6>FmJ&cpk5;s`>s@5w%{ME-CuXxLSHAN`ZuH>UN?JzD z!W30y)XAbCjhvk+D07;6hcjl)`E1myIz0W2Y!hr7;e1UPwG`Bq2B59;#v+O%lH3AI z45h4=58TnuBf6oM5faTtB#FD#0~FeY?~6Sr_Z*Fgh&ekLBm1=bOmY%6oQ@! zDlR2fPl@Q!%f~Vpv~rEiz}X~#%)uICT!}=>V2u*A#u$nnr0yYd;~+G1fEw57bY%tE0|L*RKyWMue0dwnhKX12+DQBau-am0F612jbgHK1BJC@4yx zC{n6Hp+*E19S?SSb;?};qA4H`i#|(OV8KNP%ASUtcT}>=Q`xX8s;pp$GHDjDs>T}f zr;V~K5&gEk$W)5-&NCT|FRki#Im>NWi+Jw?LW~h2z)~>=GIG#2N?{_E0t%y!Da8av z7<2I0ZQ`YoJT=|$rIjf~kVZ%aVFe0^O&F5ph@F{PrmB3rv2m8F8={LU{D&gKYH=|o zL*e^=UL5alGtaCmo!#3?)un4~g&7o>fH|Gpo@uIUeS3Njeg3#}y|&hrrK}gCfx>Bu z8Lc{KHmX#hs*#azxNhiHnYqDLQ*`cbeLFl(jb&9x(f`0L8jmoCOcb<%s$*+Sp8X|F; zKeo4czjXrzLNe5lt<`#Wv(@%)>!YD!U@RkUEE#RrZ7M8j_J7m0q?o+mI%&9}3lh zL^yT5JacnZTXa_O8TZ&i`=4~i4n@pqGVAWSbZ3YWpnBYLVW6*UOdl!rYIl~p+*NTJ zNOYmp7SYm$t6ZQ6Vo#^tV(X3{o6(U~`CJ+jmi1$B zxbDT`=tH0BJ85x6!^sq&TMEk=8}rkJo1LM3p1vHfmEHPG^-*R0@F=C)_3fZPbjVXFd44S`AEUsnKgkli>pmlquB>kJbA$J(4r zg{ULiVa3zt@VD=WD9Xk>e}WwSX3;(uS5T3N4mO2NV1;6UO8Vf!V_AYjnOj(R+Zz{O z&24eD(CN>;qd-bw--4!`t}?T?VjOw~3l5c)tAdU+P2HFP;#Dt|vN-7a+tIj1?v2(` zFN4sHk#|?CqaY~pAs5Mt1+2BsvYl^aU_v^Ojp!n8Jez57tq@C$vXG4>GjXPDS2yF+ zce)P7)oBJW=l2={<#4IoNHF01AI(8L!idBpo4kBU-G z84@TCt!DNR>sVS=wVv&G;I&F>5H@M2W5wbEDF(#4R;2eMk8Zfys}&YZPOF4O8*B(qPXbIzIHnAQ`zS2SZ3je^w?#K_ep~36EjTTUh>O?M0 zH72@jP(_-EXjN!+NaeqZGN(DPlOW9DK_iLqat=^c?r5JA4_f0fEgHTON?=SIv|Bx0 zxjO9i=HkygYgEQ|P>nre=U}?tp=ltIDckRH0$6R;1dv35!lTLVnU0N`RZtrs~a_0?mWXlui*YctLQ>JZwOtA%RRdQ)$fxYc~_V(_U> z)>0xURM+BVrBPYH&8yC`r$Lr@&v!q< zH^Wr0EQ)nf Date: Thu, 30 Oct 2025 20:51:27 +0100 Subject: [PATCH 05/12] new strings --- inst/translations/translation_da.csv | 50 ++++++++++++++++++---------- inst/translations/translation_de.csv | 16 +++++++++ inst/translations/translation_sv.csv | 16 +++++++++ inst/translations/translation_sw.csv | 16 +++++++++ 4 files changed, 81 insertions(+), 17 deletions(-) diff --git a/inst/translations/translation_da.csv b/inst/translations/translation_da.csv index a65f4de4..26c03b2b 100644 --- a/inst/translations/translation_da.csv +++ b/inst/translations/translation_da.csv @@ -255,20 +255,36 @@ "Choose a name for the column to be created or modified, then enter an expression before clicking on the button below to create the variable, or cancel to exit without saving anything.","Vælg et navn til den nye variabel, skriv din formel og tryk så på knappen for at gemme variablen, eller annuler for at lukke uden at gemme." "Please fill in web address and API token, then press 'Connect'.","Udfyld serveradresse og API-nøgle, og tryk så 'Fobind'." "Other","Other" -"Hour of the day","Hour of the day" -"Breaks","Breaks" -"By day of the week","By day of the week" -"By weekday","By weekday" -"By week number and year","By week number and year" -"By month and year","By month and year" -"By month only","By month only" -"By quarter of the year","By quarter of the year" -"By year","By year" -"Keep only most common","Keep only most common" -"Number","Number" -"Combine below percentage","Combine below percentage" -"Percentage","Percentage" -"By specified numbers","By specified numbers" -"By quantiles (groups of equal size)","By quantiles (groups of equal size)" -"By week number","By week number" -"There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Hour of the day","Time på dagen" +"Breaks","Grupper" +"By day of the week","Efter ugedag" +"By weekday","Efter ugedag" +"By week number and year","Efter ugenummer og årstal" +"By month and year","Efter måned og årstal" +"By month only","Efter måned alene" +"By quarter of the year","Efter kvartal" +"By year","Efter år" +"Keep only most common","Behold kun de hyppigste" +"Number","Antal" +"Combine below percentage","Kombiner under procentsats" +"Percentage","Procentsats" +"By specified numbers","Efter specifikke værdier" +"By quantiles (groups of equal size)","I grupper af samme størrelse" +"By week number","Efter ugenummer alene" +"There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","Der er mere avancerede muligheder for at ændre kategoriske variable, oprette nye kategoriske variabler fra eksisterende data eller nye variable baseret på R-kode. Nederst kan du gendanne originale data." +"Split the variable","Split the variable" +"Original data","Original data" +"Preview of result","Preview of result" +"Save new data","Save new data" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Variable to split:","Variable to split:" +"Text or character to split string by","Text or character to split string by" +"Select delimiter","Select delimiter" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Browse data preview","Browse data preview" +"Split character string","Split character string" +"Split text","Split text" +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." +"Split a character string by a common delimiter","Split a character string by a common delimiter" diff --git a/inst/translations/translation_de.csv b/inst/translations/translation_de.csv index 450ccbe0..26c5b022 100644 --- a/inst/translations/translation_de.csv +++ b/inst/translations/translation_de.csv @@ -272,3 +272,19 @@ "Generating the report. Hold on for a moment..","Generating the report. Hold on for a moment.." "We encountered the following error creating your report:","We encountered the following error creating your report:" "There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Text or character to split string by","Text or character to split string by" +"Split the variable","Split the variable" +"Save new data","Save new data" +"Variable to split:","Variable to split:" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Split character string","Split character string" +"Split text","Split text" +"Split a character string by a common delimiter","Split a character string by a common delimiter" +"Select delimiter","Select delimiter" +"Browse data preview","Browse data preview" +"Original data","Original data" +"Preview of result","Preview of result" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." diff --git a/inst/translations/translation_sv.csv b/inst/translations/translation_sv.csv index 7ea68df4..d919a72e 100644 --- a/inst/translations/translation_sv.csv +++ b/inst/translations/translation_sv.csv @@ -272,3 +272,19 @@ "Generating the report. Hold on for a moment..","Generating the report. Hold on for a moment.." "We encountered the following error creating your report:","We encountered the following error creating your report:" "There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Text or character to split string by","Text or character to split string by" +"Split the variable","Split the variable" +"Save new data","Save new data" +"Variable to split:","Variable to split:" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Split character string","Split character string" +"Split text","Split text" +"Split a character string by a common delimiter","Split a character string by a common delimiter" +"Select delimiter","Select delimiter" +"Browse data preview","Browse data preview" +"Original data","Original data" +"Preview of result","Preview of result" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." diff --git a/inst/translations/translation_sw.csv b/inst/translations/translation_sw.csv index 6eade044..7e53f862 100644 --- a/inst/translations/translation_sw.csv +++ b/inst/translations/translation_sw.csv @@ -272,3 +272,19 @@ "By quantiles (groups of equal size)","By quantiles (groups of equal size)" "Please fill in web address and API token, then press 'Connect'.","Please fill in web address and API token, then press 'Connect'." "There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Text or character to split string by","Text or character to split string by" +"Split the variable","Split the variable" +"Save new data","Save new data" +"Variable to split:","Variable to split:" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Split character string","Split character string" +"Split text","Split text" +"Split a character string by a common delimiter","Split a character string by a common delimiter" +"Select delimiter","Select delimiter" +"Browse data preview","Browse data preview" +"Original data","Original data" +"Preview of result","Preview of result" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." From a1cc2d8955f9218063501c6f9865f2e38774ccba Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 30 Oct 2025 20:52:17 +0100 Subject: [PATCH 06/12] dev version updated --- R/sysdata.rda | Bin 2762 -> 2806 bytes SESSION.md | 5 +++++ inst/translations/translation_da.csv | 2 +- inst/translations/translation_de.csv | 2 +- inst/translations/translation_sv.csv | 2 +- inst/translations/translation_sw.csv | 2 +- 6 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/sysdata.rda b/R/sysdata.rda index 98908065c8d930ee00aeab5c6790a525bc694740..874a0e2297416fdb7283f22b1d3cec161dda7ffb 100644 GIT binary patch literal 2806 zcmVT4*^jL0KkKS=GQU2LKv%f5QL&Xazw3|KNXb-@w2B|L{Nn5C8}P;0%8k z9gU68P#$_}mFxiW3J;D4&3AG| z)M#jFp`q$D00003Y5)La!7OtVIYy!xi|7k&q*XA*0Csh#RbAh%62(Mpu!Y_4o{aMl z7{eatvv+XJC$1@ZCA0-YDTiuxFz4F05P^;WDmu|0#$7xNzi;*5eeS1zKYy~1!{zj7 zAbxhCIw$h8(x#<$54reJZ^{F8(vA3Cah2;_Yk?!K%F`hK)e<{bb{08Ap+-ASBSuJt zZsyv`Xt5r80ZcVYwiHyoJ*+bosDLC~;F*Heq@x^)t0{wp#5p5ejy`WEmUO?K#&4Zj&GWJovzr?cET=@@_-Vgg*+j>x3Ezm&k)}qP zS#_m>5XM7tNe;r{ zh|GmLl)&ZGSnALi6@i3Du(KRHq>~Yv!8Ma7brBqOR%&i6>j!cbetk9C_ zDr(kaGGZuLcS1y@lc<;w7cP8p)8dd!!BXcMPX5L>enwgG-A-KbNyOn5plxTL0~9a- zr47UYQ@o0;_v_-nXAZo`2Wlz`XcZJ3$6;(x2DuRSjV6ahO zEKo#Psu2|dKvYo{F^aJiV4|!Y-`nViX_)(XRe zw^wwo6%^A7`Lc#`*IY2@>vNhaskR+Boig>u3yz!&P)VEC391TXOzGD&?m(iCpoK?x zT_%BoC9Pdsl8A$;%sCAz(-s&Jhzm6$+GrpN7L2gqtrIgO+PS9c6iKVPEU9D!ng}_G zr!)mla;FT!Pb15z@7Mw~n-R?cp9Cik`(4wSvprr2?3P7)iegI+Be z`A%UVo09ApS+}Y4lOv^>y&U1zB0YDw1et~#QCM}$ku}(c6H<}TIwv9Nofe^|8i;z5!_-a7 zF!m%CCSVgvB?L?o*4(QPa>H5@s+RzgnMgNlCWF2 z%%w#YqfCJ%hEmo`2i>G(_tW2>KU7g1B3-iys%Xfeq*Hs@n-R8rAHEWH5JE(R2#^lM zl1-r`r~ybR+LEH;R9QV=Pe(5t$YRmTH!}lr5(6^?X^nCv6D?3iiCSX}MGnb3L@r!p z5_dY9)Fxuu!o~{*AvJR)x8Y1;jP8UOdEQ(IU@(fXL_FqB^E_OEg{vi$DIdLNPHIk& z@-lgRyzzWXN{cP6zkx9@japLPTIL~8qR1Im0T)+2R{NiVM%)o=9Tf?fzBe9)K+_aJ z(`Xis8VVAq3KXi4Xi^}Ag!vy2dA*PkkXat|^_s&53M_mn>7_ee)hT77eX9bfs}dp% znnu`FV-0vyzS$NC{_9=#$YMo$PML{`FVy*bIm>NWi+Jw?LW~h2z)~U%WaXf4mLkYh z5Rwh?4j_Us$*GdV-*o{ZU2aKr6x1l9MhL)z0L|Lcc4ZML+u zwSx3nI88A_HK$Dm(P&z+Wb^h-`K*&Pgd~vp&6?E8?4E>@A0czZFK;{X)YpVI6)ovy z?7p9=lxeD3EVlv80EN<~qDaT03PGD(?ReN6mN5%Hz$*2QogtrJ%>(750%d z$Is)VB6bnb& zIs}59C(y7AC8De=CP2k)$V2gAR7HLQbM*hR{td1iL)aO1wftHmF$7cc51%Rej`)YP>&hjwldq0Ca*sW6@f%Jb-g_D zb5&z=R)RG53@(jKqgz!L@uKqG($?51&R#goWU!>sbxCCQl&d+8!KD zbUP92)^IAZTQR_tWwa6wCacLPHU%evd1wxq4Ya|&t?oK!(ikQGkCF`R-XqAvi;tti z-=sQYD;V+qh;{poqMi3wIT(Q9XjLl&D-;4(lo(8FFi3GLYY*ES7hj^<<7=VIk2knx z2sH1(RHs$OR(A9u$BUa8jy$7Rck9>u)CD=ECY)SDh$EwEUg^V^F)Y zLeq0(1+H56;8)=-Y9VY;jK!)?Veu{Xn3oA-AsUL4ai&aH7whG_;RkE6S;34texpEL zR|&XAE@}Otbcx{%j6yhhPk^2zWLOcR3@614nan|O)xfR@kHT~jFFm5cx3+ zp~uC=4E&SXJdF+Ht}t^cR}xWzWKmO4Oluv)Ag%=T_9X1G}2G?U1~ovQC_JzE4LnMjrFnp5I*7kp|vMO~jgOT*mE%(B$(p}0^6Q08Euy`dcM+AQJXTxzL86s zE322ThL$TWatY^O7O@^e>j?+iS9{D;ZXkQ6H^&&Z`g2)Iht`N)O*JOT+MtUy5X`IG zcwBdF@zJn|dbz2$D=8!t)F9PZZ5kmnK-h_+SN$P z$`PlqT@gRV6tFP`E@iFdOmI%8bMu z%zzML+G>k^$+oz0A@u{ujYn;rnio)p)V*8lR-?|Vd#jA^Dpz(BQ??X{iW6(~quXOW zt5&Pllyl)OYP?*c25i})$4I_iTB)Co&As$iR`4@w`Yb8vGU(Y(e7|IHhPi4iikZ~p zYO{4!PZ2ALcBbX*DGet?VOc69n@guH5~jlYin1<|b94?6I7kc?LX3e%@c)asBAh5l IYTy?GfTFY+Pyhe` literal 2762 zcmV;*3N`gYT4*^jL0KkKSv7zGg8&)bf5iX)Xazw3|KNXb-@w2B|L{Nn00IaB;0#|D zAqzb~a4AU85)>aE008s=4-HH}6F?z|XhxYP(2=L9wM-_B01X~ViRgMzYI!sgl{7s~ znx~|~15E$`(W4*%kOqJn9B617G|1CNnE{D{00E#h2AKhYG6b4PiV|tDN$8$}8a+%+ zsfZ04Fe5<3zy#Ak%BQG3NsR<#*$jX~BWg4TBPIX@dT0QF5>Yih3V5fe8UsVrJw|{4 z007g}007B?Smq{jj9_LmP!`)lid_T&(ZQe za7=`j&=m}&+cT+le75TV7r|6VUL*L+y~+0fVf*GA|Gw{Je;>=sXt@2hAv!hsO=(qQ z`@i2SKNt;m$~RwardKU%RS6w@C_x9oPDgU?E-|!96kl>1)U7pfb8(cBVfbhTE)^=+ zPNoEHVV7EL2@dc~!G&ojks_+ffN;ZcBo7OprOC{CvN}J9Q}@5N@O1cd6t!gCdTzSy z2o7475qel=+!n@};It+&hQnbJ0ew`MTliosD>3L1U7 zj-JA!u@MmFXXfkeOc{MU=qe8E&5DksL{(K4WL1h0V!=U07DW^hf{P%kq(p)YQH)r{ z7$~a|BEevys;usL-5TG9apF%FB+_|Jl&g5-GkG+c!BE)k)!i$FMKr>`ETNoQ>w^wX zcR0~iO|a#}<(HluE;?{AK_+ilCa5kn&UMC}$P`iRLW#y1q|>C{Sl9E0cNCJC_w;7v}Ob{v`oyCYUZLTrzWoG!C5d2c_dQJ(tvkM8o7~+RgZ3}_8V~s zW<1KscZk$D!i8++=TdKbjX{c28>&h*4$hflb&S{Nqav)54Kk<}vmj2>I=w`&i-G)0+VpFC)5&g# zq9}nHny6$nlY5PkH7O7X2O88J7)}&0+-gh+)0>zsHY6AmEE7q}(qzTy&E8Du-WhZy zRWe9Kw2*+5=GKIbyNy(ulA0_X3@9B!2%XDwcc^B{QwbX~MH#HRnKVNqXD3QZ9K)l^ zJl@233p~GvcoqOA!8=}A#>l>^N1XyWkZLmFJ8 zb1*j~ATpRV#<>!SmWm@pwqq(RIwa{3xp9z5)aq+NGZxksFjz5=)y$UP@|eXL)d(=| z_wXTr!YaWK?y`3b>v9Gbtd>x)e|?!a)SRK($=~ns*7cT^7F$>NB}^k$mfkIM5U5ib z)3tY!=X5Q<2% zADXmFB3eX{SoPD(N_9J`Qp-{OObVi`NQg3N8(~$9HP=rX*%T4@ZFkclj1}cMW+o)Q zkAs7bEwy4T;ob&?7$QZ0q(m6W#h`AMBFIz{LJnAm5fm6<$A-h-ihz+ZTZTe7p+yo9 zMnDR}3o0QrV+)odbRk)$s(x&u<1JQhid$u0J;*ELOVpL0Ru?B7D#($dxo!AY`diW#jsXrpMhTCrsA?3?uOY4dhKgoekq znz5;&asebZ9{au+JJs1?Hu?}dYdLG{5pS`el+WDCjuqTU9&p%;1b|5q+#)7dek6g1 z(U7I7k^m$Ft!27VDtQ2sHU6sZH3C3G+;QQm$6V$E3z7nXWF;>T&D+0!pyT2CzPAZc9-tiO{g4EkYYr1YSgFQi=Ejqn$ z`6aqT?{L>OHaeB|P|7hK4&s4seU(ro6zM*NsKQ<;(OEJED{ev`lM1zlU*s%Tn42;%&{7oJiCoAXBezA?1MnIi zxpCZ=vILgSdTkCAX7`sX!3Y<9$D`sddLk z==5Zjem4e$n{?VOJ9M~O_wxD<$+)87!YM$q6&9Hr@!Pv&c9+ZhH+9_`h)&FV$J60m zBEk_D0+(XQYsE2n2R6X);%lMWk6x33Q-ayH@==z+NI4p>B%s(7o(1dN4ssgj2K8@o z&aSY*FVy*<>$7-|GgmK12tRZ><0}~P?;+XkHi_@Lx};(Qg`rbeAy}Xiy>MYQdL0f$ zZDIQ(V(auwAhBf>(vVTciMyL`QmK6wNaMBjx0UT= zE}Tm9nh~xI>hk2s342II@?wEtSWcpyPh?<1IuMM+VDs>9CBCx~;Vfh$Nle^nlNHJO zx$XWCcB>Vf7{i~`XbX+Prv<$6FTH2fMQ}n7FuSZu3Fk&dfb>CXIojjJ1{wb>wVvEHYFZc0�uKyp_rhWYx%&V3`zEN*LBVh(TNl$@3*vb~B&v z*`!hh*&b!!S4G%+3GlBLf-8*mFIfGiG8?4wFz0Ez${kn;=20bl)g>M$BJYIG(LUd< z+j+X%@)M<#p!;vi6`%{(oq|#!zvHRd7im~l7L7~_&5d%wQeqXwFv0u5Y|W!Bk?2lW z+Dd9ORybAGD04+w^Y&2E#bv5NJnQ7vBgj{B545iR#wTtddukiwj9Yy3SxSf2h)g9O zs%%h2nuu*GwjD7(JGdh%bDIe=4BrX~98ZIgae&a~iRdu(u3|Z|jq*xhOdE4sK7Up& zyDTzsWtFw6V=E{|o)w1Nxf=o3!JFkHPV13mDpe_uC53Q}yO*K?=cNC?HSI&JQ*HC|I)+A349 zDG?MZYxN`BV?36vH?1h?!d(@3xkL=vhUJd2e7NbW#|@qGsI1^-)$6XE!!3AEK7V8{ zhM8zAN_A4?YO{4T)qs`6yHjfLDGk+87* Date: Fri, 31 Oct 2025 11:36:54 +0100 Subject: [PATCH 07/12] feat: further improved new factor interface --- R/cut-variable-ext.R | 95 ++++++++++++++++++++++++++++---------------- R/cut_var.R | 9 ++++- 2 files changed, 69 insertions(+), 35 deletions(-) diff --git a/R/cut-variable-ext.R b/R/cut-variable-ext.R index 356a2ba2..c1879b7c 100644 --- a/R/cut-variable-ext.R +++ b/R/cut-variable-ext.R @@ -35,14 +35,7 @@ cut_variable_ui <- function(id) { ), column( width = 3, - numericInput( - inputId = ns("n_breaks"), - label = i18n$t("Number of breaks:"), - value = 3, - min = 2, - max = 12, - width = "100%" - ) + shiny::uiOutput(ns("n_breaks")) ), column( width = 3, @@ -123,8 +116,38 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # ) }), data_r(), input$hidden) + output$n_breaks <- shiny::renderUI({ + req(input$method) + # req(!is.null(get_list_elements(name = input$cut_method,element = "breaks"))) + # browser() + + break_text <- get_list_elements(name = input$method, element = "breaks") + + if (is.null(get_list_elements(name = input$method, element = "min"))) { + min <- 2 + } else { + min <- get_list_elements(name = input$method, element = "min") + } + + if (is.null(get_list_elements(name = input$method, element = "max"))) { + max <- 10 + } else { + max <- get_list_elements(name = input$method, element = "max") + } + + numericInput( + inputId = ns("n_breaks"), + label = break_text, + value = 3, + min = min, + max = max, + width = "100%" + ) + }) + output$slider_fixed <- renderUI({ data <- req(data_r()) + req(input$n_breaks) variable <- req(input$variable) req(hasName(data, variable)) @@ -221,14 +244,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { selected = NULL, width = "100%" ) - - # shinyWidgets::virtualSelectInput( - # inputId = session$ns("method"), - # label = i18n$t("Method:"), - # choices = choices, - # selected = NULL, - # width = "100%" - # ) }) @@ -389,7 +404,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ), responseName = "count" ) - count_data$freq <- paste(signif(count_data$count/nrow(data)*100,3),"%") + count_data$freq <- paste(signif(count_data$count / nrow(data) * 100, 3), "%") # browser() gridTheme <- getOption("datagrid.theme") if (length(gridTheme) < 1) { @@ -398,7 +413,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { on.exit(toastui::reset_grid_theme()) grid <- toastui::datagrid( data = count_data, - colwidths = "guess", + colwidths = "fit", theme = "default", bodyHeight = "auto" ) @@ -486,55 +501,63 @@ cut_methods <- function() { "hour" = list( descr = i18n$t("Hour of the day"), # class = c("hms", "POSIXct"), # Not implemented yet, but will during rewrite at some point... - breaks = i18n$t("Breaks") + breaks = NULL ), "day" = list( descr = i18n$t("By day of the week"), - breaks = i18n$t("Breaks") + breaks = NULL ), "weekday" = list( descr = i18n$t("By weekday"), - breaks = i18n$t("Breaks") + breaks = NULL ), "week" = list( descr = i18n$t("By week number and year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "week_only" = list( descr = i18n$t("By week number"), - breaks = i18n$t("Breaks") + breaks = NULL ), "month" = list( descr = i18n$t("By month and year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "month_only" = list( descr = i18n$t("By month only"), - breaks = i18n$t("Breaks") + breaks = NULL ), "quarter" = list( descr = i18n$t("By quarter of the year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "year" = list( descr = i18n$t("By year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "top" = list( descr = i18n$t("Keep only most common"), - breaks = i18n$t("Number") + breaks = i18n$t("Number"), + min = 1, + max = 20 ), "bottom" = list( descr = i18n$t("Combine below percentage"), - breaks = i18n$t("Percentage") + breaks = i18n$t("Percentage"), + min = 1, + max = 50 ), "fixed" = list( descr = i18n$t("By specified numbers"), - breaks = i18n$t("Breaks") + breaks = i18n$t("Breaks"), + min = 2, + max = 12 ), "quantile" = list( descr = i18n$t("By quantiles (groups of equal size)"), - breaks = i18n$t("Breaks") + breaks = i18n$t("Breaks"), + min = 2, + max = 10 ) ) } @@ -555,9 +578,13 @@ cut_methods <- function() { #' @examples #' get_list_elements(c("top", "bottom"), "descr") get_list_elements <- function(name, element, dict = cut_methods()) { - sapply(dict[name], \(.x){ - .x[[element]] - }) + if (is.null(name)) { + return(NULL) + } else { + sapply(dict[name], \(.x){ + .x[[element]] + }) + } } #' Set values as names and names as values diff --git a/R/cut_var.R b/R/cut_var.R index f7c1c2c2..d2fab621 100644 --- a/R/cut_var.R +++ b/R/cut_var.R @@ -184,9 +184,16 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other = tbl <- sort(table(x), decreasing = TRUE) if (type == "top") { + if (length(levels(x)) <= breaks){ + return(x) + } lvls <- names(tbl[seq_len(breaks)]) } else if (type == "bottom") { - lvls <- names(tbl)[!tbl / NROW(x) * 100 < breaks] + freqs_check <- tbl / NROW(x) * 100 < breaks + if (!any(freqs_check)){ + return(x) + } + lvls <- names(tbl)[!freqs_check] } if (other %in% lvls) { From ebc8c656284879c749c0d24c24ad24692e1041c8 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 31 Oct 2025 11:37:57 +0100 Subject: [PATCH 08/12] feat: table rendering set factor levels limit to 20 --- R/missings-module.R | 15 +++++++++++++-- man/data-missings.Rd | 2 +- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/R/missings-module.R b/R/missings-module.R index 7513185b..1cd70564 100644 --- a/R/missings-module.R +++ b/R/missings-module.R @@ -24,6 +24,7 @@ data_missings_ui <- function(id) { data_missings_server <- function(id, data, variable, + max_level=20, ...) { shiny::moduleServer( id = id, @@ -44,7 +45,7 @@ data_missings_server <- function(id, tryCatch( { - out <- compare_missings(df_tbl,by_var) + out <- compare_missings(df_tbl,by_var,max_level = max_level) }, error = function(err) { showNotification(paste0("Error: ", err), type = "err") @@ -133,8 +134,18 @@ missing_demo_app() #' @returns gtsummary list object #' @export #' -compare_missings <- function(data,by_var){ +compare_missings <- function(data,by_var,max_level=20){ if (!is.null(by_var) && by_var != "" && by_var %in% names(data)) { + data <- data |> + lapply(\(.x){ + # browser() + if (is.factor(.x)){ + cut_var(.x,breaks=20,type="top") + } else { + .x + } + }) |> dplyr::bind_cols() + data[[by_var]] <- ifelse(is.na(data[[by_var]]), "Missing", "Non-missing") out <- gtsummary::tbl_summary(data, by = by_var) |> diff --git a/man/data-missings.Rd b/man/data-missings.Rd index 510d78b0..72d691a5 100644 --- a/man/data-missings.Rd +++ b/man/data-missings.Rd @@ -8,7 +8,7 @@ \usage{ data_missings_ui(id) -data_missings_server(id, data, variable, ...) +data_missings_server(id, data, variable, max_level = 20, ...) } \arguments{ \item{id}{Module id} From ae9aa2e6f5a9a959a902d9fae13f0ba86aa76771 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 31 Oct 2025 11:39:12 +0100 Subject: [PATCH 09/12] feat: new distribution plotting for categorical (incl dichotomous) variables --- R/data_plots.R | 32 ++++++++++++- R/plot_bar.R | 118 ++++++++++++++++++++++++++++++++++++++++++++++ R/plot_box.R | 2 - man/data-plots.Rd | 28 ++++++++++- 4 files changed, 174 insertions(+), 6 deletions(-) create mode 100644 R/plot_bar.R diff --git a/R/data_plots.R b/R/data_plots.R index 4fb06504..24024b15 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -343,6 +343,12 @@ data_visuals_server <- function(id, ter = input$tertiary ) + ## If the dictionary holds additional arguments to pass to the + ## plotting function, these are included + if (!is.null(rv$plot.params()[["fun.args"]])){ + parameters <- modifyList(parameters,rv$plot.params()[["fun.args"]]) + } + shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."), { rv$plot <- rlang::exec( create_plot, @@ -506,7 +512,7 @@ supported_plots <- function() { fun = "plot_violin", descr = i18n$t("Violin plot"), note = i18n$t("A modern alternative to the classic boxplot to visualise data distribution"), - primary.type = c("datatime", "continuous", "dichotomous", "categorical"), + primary.type = c("datatime", "continuous"), secondary.type = c("dichotomous", "categorical"), secondary.multi = FALSE, secondary.extra = "none", @@ -544,7 +550,7 @@ supported_plots <- function() { fun = "plot_box", descr = i18n$t("Box plot"), note = i18n$t("A classic way to plot data distribution by groups"), - primary.type = c("datatime", "continuous", "dichotomous", "categorical"), + primary.type = c("datatime", "continuous"), secondary.type = c("dichotomous", "categorical"), secondary.multi = FALSE, tertiary.type = c("dichotomous", "categorical"), @@ -560,6 +566,28 @@ supported_plots <- function() { secondary.max = 4, tertiary.type = c("dichotomous"), secondary.extra = NULL + ), + plot_bar_rel = list( + fun = "plot_bar", + fun.args =list(style="fill"), + descr = i18n$t("Stacked relative barplot"), + note = i18n$t("Create relative stacked barplots to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = NULL + ), + plot_bar_abs = list( + fun = "plot_bar", + fun.args =list(style="dodge"), + descr = i18n$t("Side-by-side barplot"), + note = i18n$t("Create side-by-side barplot to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = "none" ) ) } diff --git a/R/plot_bar.R b/R/plot_bar.R new file mode 100644 index 00000000..5602269f --- /dev/null +++ b/R/plot_bar.R @@ -0,0 +1,118 @@ +plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"), max_level = 30, ...) { + style <- match.arg(style) + + if (!is.null(ter)) { + ds <- split(data, data[ter]) + } else { + ds <- list(data) + } + + out <- lapply(ds, \(.ds){ + plot_bar_single( + data = .ds, + pri = pri, + sec = sec, + style = style, + max_level = max_level + ) + }) + + wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...) +} + + +#' Single vertical barplot +#' +#' @param style barplot style passed to geom_bar position argument. +#' One of c("stack", "dodge", "fill") +#' +#' @name data-plots +#' +#' @returns ggplot object +#' @export +#' +#' @examples +#' mtcars |> +#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> +#' plot_bar_single(pri = "cyl", sec = "am", style = "fill") +#' +#' mtcars |> +#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> +#' plot_bar_single(pri = "cyl", style = "stack") +plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30) { + style <- match.arg(style) + + if (identical(sec, "none")) { + sec <- NULL + } + + p_data <- as.data.frame(table(data[c(pri, sec)])) |> + dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor), + p = Freq / NROW(data) + ) + + + if (nrow(p_data) > max_level) { + # browser() + p_data <- sort_by( + p_data, + p_data[["Freq"]], + decreasing = TRUE + ) |> + head(max_level) + # if (is.null(sec)){ + # p_data <- sort_by( + # p_data, + # p_data[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # } else { + # split(p_data,p_data[[sec]]) |> + # lapply(\(.x){ + # # browser() + # sort_by( + # .x, + # .x[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # }) |> dplyr::bind_rows() + # } + } + + ## Shortens long level names + p_data[[pri]] <- forcats::as_factor(unique_short(as.character(p_data[[pri]]), max = 20)) + + if (!is.null(sec)) { + fill <- sec + } else { + fill <- pri + } + + p <- ggplot2::ggplot( + p_data, + ggplot2::aes( + x = .data[[pri]], + y = p, + fill = .data[[fill]] + ) + ) + + ggplot2::geom_bar(position = style, stat = "identity") + + ggplot2::scale_y_continuous(labels = scales::percent) + + ggplot2::ylab("Percentage") + + ggplot2::xlab(get_label(data,pri)) + + ## To handle large number of levels and long level names + if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) { + p <- p + + ggplot2::guides(fill = "none") + + ggplot2::theme( + axis.text.x = ggplot2::element_text( + angle = 90, + vjust = 1, hjust = 1 + ))+ + ggplot2::theme( + axis.text.x = ggplot2::element_text(vjust = 0.5) + ) + } + p +} diff --git a/R/plot_box.R b/R/plot_box.R index 989a112f..072a8095 100644 --- a/R/plot_box.R +++ b/R/plot_box.R @@ -39,8 +39,6 @@ plot_box <- function(data, pri, sec, ter = NULL,...) { } - - #' Create nice box-plots #' #' @name data-plots diff --git a/man/data-plots.Rd b/man/data-plots.Rd index c77fa109..e5f94f58 100644 --- a/man/data-plots.Rd +++ b/man/data-plots.Rd @@ -1,11 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_plots.R, R/plot_box.R, R/plot_hbar.R, -% R/plot_ridge.R, R/plot_sankey.R, R/plot_scatter.R, R/plot_violin.R +% Please edit documentation in R/data_plots.R, R/plot_bar.R, R/plot_box.R, +% R/plot_hbar.R, R/plot_ridge.R, R/plot_sankey.R, R/plot_scatter.R, +% R/plot_violin.R \name{data-plots} \alias{data-plots} \alias{data_visuals_ui} \alias{data_visuals_server} \alias{create_plot} +\alias{plot_bar_single} \alias{plot_box} \alias{plot_box_single} \alias{plot_hbars} @@ -22,6 +24,14 @@ data_visuals_server(id, data, ...) create_plot(data, type, pri, sec, ter = NULL, ...) +plot_bar_single( + data, + pri, + sec = NULL, + style = c("stack", "dodge", "fill"), + max_level = 30 +) + plot_box(data, pri, sec, ter = NULL, ...) plot_box_single(data, pri, sec = NULL, seed = 2103) @@ -60,6 +70,9 @@ plot_violin(data, pri, sec, ter = NULL) \item{sec}{secondary variable} \item{ter}{tertiary variable} + +\item{style}{barplot style passed to geom_bar position argument. +One of c("stack", "dodge", "fill")} } \value{ Shiny ui module @@ -68,6 +81,8 @@ shiny server module ggplot2 object +ggplot object + ggplot2 object ggplot object @@ -89,6 +104,8 @@ Data correlations evaluation module Wrapper to create plot based on provided type +Single vertical barplot + Beautiful box plot(s) Create nice box-plots @@ -107,6 +124,13 @@ Beatiful violin plot } \examples{ create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes() +mtcars |> + dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> + plot_bar_single(pri = "cyl", sec = "am", style = "fill") + +mtcars |> + dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> + plot_bar_single(pri = "cyl", style = "stack") mtcars |> plot_box(pri = "mpg", sec = "gear") mtcars |> plot_box(pri = "mpg", sec="cyl") mtcars |> From 913844d34b987739f6a113c1b4243eec5a59a2d6 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 31 Oct 2025 11:39:28 +0100 Subject: [PATCH 10/12] new strings --- inst/translations/translation_da.csv | 5 ++++- inst/translations/translation_de.csv | 5 ++++- inst/translations/translation_sv.csv | 5 ++++- inst/translations/translation_sw.csv | 5 ++++- 4 files changed, 16 insertions(+), 4 deletions(-) diff --git a/inst/translations/translation_da.csv b/inst/translations/translation_da.csv index b0269010..22cafcfa 100644 --- a/inst/translations/translation_da.csv +++ b/inst/translations/translation_da.csv @@ -49,7 +49,6 @@ "Column added!","Variabel oprettet!" "Unique values:","Unikke værdier:" "Variable to cut:","Variabel, der skal deles:" -"Number of breaks:","Antal niveauer:" "Close intervals on the right","Luk intervaller til højre" "Include lowest value","Inkluderer den laveste værdi" "Create factor variable","Opret kategorisk variabel" @@ -288,3 +287,7 @@ "Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." "Split a character string by a common delimiter","Split a character string by a common delimiter" "Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" diff --git a/inst/translations/translation_de.csv b/inst/translations/translation_de.csv index 370673db..d8947867 100644 --- a/inst/translations/translation_de.csv +++ b/inst/translations/translation_de.csv @@ -18,7 +18,6 @@ "Column added!","Column added!" "Unique values:","Unique values:" "Variable to cut:","Variable to cut:" -"Number of breaks:","Number of breaks:" "Close intervals on the right","Close intervals on the right" "Include lowest value","Include lowest value" "Create factor variable","Create factor variable" @@ -288,3 +287,7 @@ "No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." "Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." "Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" diff --git a/inst/translations/translation_sv.csv b/inst/translations/translation_sv.csv index adf9b388..b9e18015 100644 --- a/inst/translations/translation_sv.csv +++ b/inst/translations/translation_sv.csv @@ -18,7 +18,6 @@ "Column added!","Column added!" "Unique values:","Unique values:" "Variable to cut:","Variable to cut:" -"Number of breaks:","Number of breaks:" "Close intervals on the right","Close intervals on the right" "Include lowest value","Include lowest value" "Create factor variable","Create factor variable" @@ -288,3 +287,7 @@ "No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." "Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." "Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" diff --git a/inst/translations/translation_sw.csv b/inst/translations/translation_sw.csv index 7f8dfaa7..70d1fe1c 100644 --- a/inst/translations/translation_sw.csv +++ b/inst/translations/translation_sw.csv @@ -49,7 +49,6 @@ "Column added!","Column added!" "Unique values:","Unique values:" "Variable to cut:","Variable to cut:" -"Number of breaks:","Number of breaks:" "Close intervals on the right","Close intervals on the right" "Include lowest value","Include lowest value" "Create factor variable","Create factor variable" @@ -288,3 +287,7 @@ "No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." "Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." "Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" From 747670bb576723fc459ea65dfacc5ff23790de26 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 31 Oct 2025 11:39:44 +0100 Subject: [PATCH 11/12] rendering --- DESCRIPTION | 1 + NAMESPACE | 4 ++ NEWS.md | 6 +- R/hosted_version.R | 2 +- R/separate_string.R | 123 ++++++++++++++++++++++++++++++++-------- R/sysdata.rda | Bin 2806 -> 2840 bytes SESSION.md | 8 ++- man/compare_missings.Rd | 2 +- man/split-string.Rd | 44 ++++++++++++++ 9 files changed, 161 insertions(+), 29 deletions(-) create mode 100644 man/split-string.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 1c3b44e8..bb7e367e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -112,6 +112,7 @@ Collate: 'launch_FreesearchR.R' 'missings-module.R' 'plot-download-module.R' + 'plot_bar.R' 'plot_box.R' 'plot_euler.R' 'plot_hbar.R' diff --git a/NAMESPACE b/NAMESPACE index 1544994a..127b112c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -100,12 +100,14 @@ export(missings_apex_plot) export(missings_validate) export(modal_create_column) export(modal_cut_variable) +export(modal_string_split) export(modal_update_factor) export(modal_visual_summary) export(modify_qmd) export(names2val) export(overview_vars) export(pipe_string) +export(plot_bar_single) export(plot_box) export(plot_box_single) export(plot_euler) @@ -137,6 +139,8 @@ export(show_data) export(simple_snake) export(sort_by) export(specify_qmd_format) +export(string_split_server) +export(string_split_ui) export(subset_types) export(supported_functions) export(supported_plots) diff --git a/NEWS.md b/NEWS.md index 5658b0c6..1345a963 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,10 @@ # FreesearchR 25.10.5 -*NEW* New character/text split function available. A selection of delimiters are recognised and selectable. Function only available if splittable variables are present. This was the last big function to implement after workshops at Jitimai in Zanzibar. +*NEW* New character/text split function available. A selection of delimiters are recognised and selectable. Function only available if splittable variables are present. + +*NEW* Distribution plotting for factors have been much improved including two new bar plot styles and removing options better suited for continuous data. + +These were the last major functions to be implemented after workshops at Jitimai in Zanzibar City, Zanzibar during October 2025. # FreesearchR 25.10.4 diff --git a/R/hosted_version.R b/R/hosted_version.R index b917069a..125f33e1 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.10.5-251030' +hosted_version <- function()'v25.10.5-251031' diff --git a/R/separate_string.R b/R/separate_string.R index 38a243bb..0aa64e6c 100644 --- a/R/separate_string.R +++ b/R/separate_string.R @@ -1,3 +1,12 @@ +#' String split module based on tidyr::separate_ +#' +#' @param id id +#' +#' @returns A shiny ui module +#' @export +#' +#' @name split-string +#' string_split_ui <- function(id) { ns <- NS(id) tagList( @@ -26,17 +35,17 @@ string_split_ui <- function(id) { ), shiny::fluidRow( column( - width = 3, + width = 4, shiny::h4(i18n$t("Original data")), - shiny::tableOutput(outputId = ns("orig_data")) + toastui::datagridOutput2(outputId = ns("orig_data")) + # DT::DTOutput(outputId = ns("orig_data_3")) # This doesn't render... # toastui::datagridOutput2(outputId = ns("orig_data_2")) ), - column(width = 1), column( width = 8, shiny::h4(i18n$t("Preview of result")), - shiny::tableOutput(outputId = ns("new_data")) + toastui::datagridOutput2(outputId = ns("new_data")) ) ), actionButton( @@ -50,11 +59,18 @@ string_split_ui <- function(id) { +#' @param data_r reactive data +#' +#' @returns shiny module server +#' @export +#' +#' @name split-string +#' string_split_server <- function(id, data_r = reactive(NULL)) { moduleServer( id, function(input, output, session) { - rv <- reactiveValues(data = NULL, temp = NULL, out=NULL) + rv <- reactiveValues(data = NULL, target=NULL, temp = NULL, out=NULL) ns <- session$ns @@ -80,6 +96,8 @@ string_split_server <- function(id, data_r = reactive(NULL)) { }, logical(1)) vars_num <- names(vars_num)[vars_num] + req(length(vars_num)>0) + output$variable <- shiny::renderUI( columnSelectInput( inputId = ns("variable"), @@ -103,6 +121,7 @@ string_split_server <- function(id, data_r = reactive(NULL)) { req(input$variable) # browser() + req(input$variable %in% names(rv$data)) # req({ # any(apply(data_r(),2,is_splittable)) # }) @@ -180,36 +199,46 @@ string_split_server <- function(id, data_r = reactive(NULL)) { ## Toastui would not render the original data, so the solution was to go ## with native table rendering, which works, but doesn't please the eye - output$orig_data <- shiny::renderTable({ - req(data_r()) - req(input$variable) - data <- data_r() |> - dplyr::select(tidyselect::all_of(input$variable)) - # browser() - head(data, 10) - }) - - # output$orig_data_2 <- toastui::renderDatagrid2({ + # output$orig_data <- shiny::renderTable({ # req(data_r()) # req(input$variable) # data <- data_r() |> # dplyr::select(tidyselect::all_of(input$variable)) # # browser() - # toastui::datagrid(head(data, 10)) + # head(data, 10) # }) + output$orig_data <- toastui::renderDatagrid2({ + req(data_r()) + req(input$variable) + req(hasName(rv$data, input$variable)) - output$new_data <- shiny::renderTable({ + data <- data_r() |> + dplyr::select(tidyselect::all_of(input$variable)) |> + head(30) |> + dplyr::mutate(row=dplyr::row_number()) |> + dplyr::select(row,tidyselect::everything()) + # browser() + toastui::datagrid( + data = data, + rowHeight = 40, + colwidths = "guess", + theme = "default", + bodyHeight = "auto", + pagination = 10) + }) + + output$new_data <- toastui::renderDatagrid2({ shiny::req(rv$temp) data <- rv$temp - head(data, 10) - # toastui::datagrid( - # data = head(data, 100), - # colwidths = "guess", - # theme = "default", - # bodyHeight = "auto", pagination = 10 - # ) + toastui::datagrid( + data = head(data, 30), + rowHeight = 40, + colwidths = "guess", + theme = "default", + bodyHeight = "auto", pagination = 10 + ) }) data_split_r <- reactive({ @@ -256,6 +285,15 @@ string_split_server <- function(id, data_r = reactive(NULL)) { } +#' @param title Modal title +#' @param easyClose easyClose +#' @param size size +#' @param footer footer +#' +#' @returns shiny modal +#' @export +#' +#' @name split-string modal_string_split <- function(id, title = i18n$t("Split character string"), easyClose = TRUE, @@ -373,3 +411,40 @@ is_splittable <- function(data) { FALSE } } + +# mtcars |> simple_dt() +simple_dt <- function(data,...){ + headerCallbackRemoveHeaderFooter <- c( + "function(thead, data, start, end, display){", + " $('th', thead).css('display', 'none');", + "}" + ) + + DT::datatable( + data, + options = list( + dom = "t", + ordering = FALSE, + paging = FALSE, + searching = FALSE, + # headerCallback = DT::JS(headerCallbackRemoveHeaderFooter), + columnDefs = list( + list( + targets = 1, + render = DT::JS( + "function(data, type, row, meta) {", + "return type === 'display' && data.length > 10 ?", + "'' + data.substr(0, 10) + '...' : data;", + "}"))) + ), + selection = 'none', + callback = DT::JS( + "$('table.dataTable.no-footer').css('border-bottom', 'none');" + ), + class = 'row-border', + escape = FALSE, + rownames = FALSE, + # width = 500, + filter = "none" + ) +} diff --git a/R/sysdata.rda b/R/sysdata.rda index 874a0e2297416fdb7283f22b1d3cec161dda7ffb..d6694eef104dd8c498804324a18967f6806622ef 100644 GIT binary patch literal 2840 zcmV+z3+MDgT4*^jL0KkKSsHWBTIJx4XL!6000^Q00*Q4C6cD{WGHGOd36M?x++6H(waxjrW;zq9a_Sj=puKK}*F>M`G&2$0(F2_9et< z$r7#H+gVK(Bga4~hN;%X%~R9b!!T$>0V3-HnGM=XG03X2m^fTRk~QOUbUdzc=}6{$ zHvEV5Yld;aqpuU{)qVHkfa3LpUMw>j(QGzrViVZYVX%p`r0D;{P8zPxCOnW%{i8xg znHp(r_!ZgaKl5NcxL)e73#X%s936B$^CnSGxb3 zQuUig%{I6&nrFX~X?dKx9v3WlMy}2*SVBR-Jpt7wVe(~}mnh?CRnoqwxrvFqrxhcWnj?3-w(Cw#_F=$Yv_(=DR?$($ z_?vl8Aw=;h87AWDnQw0v?<`n}>&F{5kW0eS_Zm|U);ES`Tlwy*KJ1c_I7MLtY(4x; zYS@CDm;&m-0J`o*8@4c4Ed#d!MKlVkFckohU`R+sR2D!|kPuWqaRnZ10YIyrC}GkX zWFknB7^14GF-1{e1U-K@?>`TS2|P?9hJCFZPi(Uvt1MJUf?tY;C_+d{B!rR*kwPf2 zMhYwiiU@+LghfD56%<8`Vj_Z~3Zkr85rTrmVv2Woy`HzntvT_hj}mD;7RJX;JaKc3 znoVG=I32pXrEsXGm{-S^8O5%+Fy!ZRjTJ>U!BDKI1e(oYnxLjM&Rub* zas?E8^eQ{TnoSOqW?9c1=GvNO`#TOpO0>m>1Y!csNVb{?0!5=NI4eZV$u_QOx`h&I z?ty0|10I1ChHjGwbg~u9j9RRz+}pX>nTF6=it@3=;xysmLbh{rsW-j6Fhp9XyHwi_ z08L{VStfr?85d-NY73xYUOi6JBFWR36++nrHGCKVYfXkAkV(+GY=R>dD{5t@3oe*j zt{uDVH`Y0C1d;{ku2{I^V}*5viHb)eW(|b2MG-^?sj6^9C~ZdG$eNUnfzde+Oz5=@ zIAlV4lEW5eoU*nc85`b(;_Gy)rOVTs&P?lgW{fJSa0w}tl0ao%ZE0)H_s*vE#@njs zN!ZcTK@+)fX75f7l%=F>%ppZqT}+xH2;fU>X=I_8*2-tvtA1B9=dYu;v&O+bAm0n( zWQ$0r)M`qRZ-O%^QABBOK$62LYbAr^q-64^mVKR3L~w~srV~`rkx8Ued)b>GS-EGw z@exbqcaM z0}ED5C{jP7%$#aYSa=yd4?~XncgsqPEv>%NVqqGzrMz0^AyB3vmi3?!b8x9mYb=qj z$h5YFAuleDBhrE&2?+rH8UsY)g&}MT1hq*?2!cro^gP|h_CQ8KKzo_#wT1~4Sof** znsn}|WtNHf=?bc=5+V$mMXV~ZhP%}6wnc(ITV9A>ER}g@EX2ka*YtQe;@egt-W}j* zQGz5`3PvEtPAvm;u@*w0fD(NcL&8WxCtclP@^;V`9lGi5rIjf~kYgkQu!4m|CX7jP z#7@L3G}TX2EL>%(hUlWoziG&@nw%yisCayx?%o%DdHTY+)4OR}w5@9dWKv=P=5*Ze z%~MM;x7(mK*6z$_S|y-KdBFQeQJ-^bT-GtzKd$blGS^ z7Dl!+H#iUgvS4fo^MMS5c1&4L$lr8!U?LdSIn7tM-|zQ+W3#|#qqa`9U*G5XzKg<+ zS3c&sV0RJn`y32>B)=&WOnp8*&1G>{#%%bYiVOj3ZQ?dvQ;eX`FlTkf+Ik`BmkE#d z;ni3TmbH7P$>clE@_}gksWBj@N%L3+65(Dp6Ch&7<{|j7tX>4u@gK*RopL1$y%=C_ z^iL$?vqp6qB53;l?R3Y$#f!Z_9R;?RMh*AFEEhC4ma=%6;S6 z=eCNtgoXg8$z(R>nY@FWaCmVw(CtUBS-`8wY|9c+me5E!ny@69uqiy{=+GTf8)}1m zoE&vitT0ReA4D7N;3Lq(i=WKi7X2aD8Cu7W@F&4+Gq=v;*R1>I3{KOm~0}vAqSXU_N2(U5s`Wk zq6{bILg(|)T-vx5%82bwf+gqtoLl!t!Q6UJ*6cM1g>y%DpxX5f@D!t zP)w{H#2~ID^!24JZIS4Ni`jK!Gqm z`UIF<84ZuIt;V|PL#UnET2+{2*9eA&0ql3CXvPp}nJL7eK*VfXE~zGqrLJwkuMWAa z&o~R_hSb4aELNl6UEXUWOe(#L#)@{rkr6_TezbdSXR&J4g3^85W!$UC>I|}Y5ZC_QTO$L2iD&N!gN3T?NPg!*pc2UUH4IN5Zn3e>)(|YnL4iubW qVJak>S7X@ctk^1%K})W4`DT#afqiwAiCMOP#oUoj6eI?m^SMAT%1itJ literal 2806 zcmVT4*^jL0KkKS=GQU2LKv%f5QL&Xazw3|KNXb-@w2B|L{Nn5C8}P;0%8k z9gU68P#$_}mFxiW3J;D4&3AG| z)M#jFp`q$D00003Y5)La!7OtVIYy!xi|7k&q*XA*0Csh#RbAh%62(Mpu!Y_4o{aMl z7{eatvv+XJC$1@ZCA0-YDTiuxFz4F05P^;WDmu|0#$7xNzi;*5eeS1zKYy~1!{zj7 zAbxhCIw$h8(x#<$54reJZ^{F8(vA3Cah2;_Yk?!K%F`hK)e<{bb{08Ap+-ASBSuJt zZsyv`Xt5r80ZcVYwiHyoJ*+bosDLC~;F*Heq@x^)t0{wp#5p5ejy`WEmUO?K#&4Zj&GWJovzr?cET=@@_-Vgg*+j>x3Ezm&k)}qP zS#_m>5XM7tNe;r{ zh|GmLl)&ZGSnALi6@i3Du(KRHq>~Yv!8Ma7brBqOR%&i6>j!cbetk9C_ zDr(kaGGZuLcS1y@lc<;w7cP8p)8dd!!BXcMPX5L>enwgG-A-KbNyOn5plxTL0~9a- zr47UYQ@o0;_v_-nXAZo`2Wlz`XcZJ3$6;(x2DuRSjV6ahO zEKo#Psu2|dKvYo{F^aJiV4|!Y-`nViX_)(XRe zw^wwo6%^A7`Lc#`*IY2@>vNhaskR+Boig>u3yz!&P)VEC391TXOzGD&?m(iCpoK?x zT_%BoC9Pdsl8A$;%sCAz(-s&Jhzm6$+GrpN7L2gqtrIgO+PS9c6iKVPEU9D!ng}_G zr!)mla;FT!Pb15z@7Mw~n-R?cp9Cik`(4wSvprr2?3P7)iegI+Be z`A%UVo09ApS+}Y4lOv^>y&U1zB0YDw1et~#QCM}$ku}(c6H<}TIwv9Nofe^|8i;z5!_-a7 zF!m%CCSVgvB?L?o*4(QPa>H5@s+RzgnMgNlCWF2 z%%w#YqfCJ%hEmo`2i>G(_tW2>KU7g1B3-iys%Xfeq*Hs@n-R8rAHEWH5JE(R2#^lM zl1-r`r~ybR+LEH;R9QV=Pe(5t$YRmTH!}lr5(6^?X^nCv6D?3iiCSX}MGnb3L@r!p z5_dY9)Fxuu!o~{*AvJR)x8Y1;jP8UOdEQ(IU@(fXL_FqB^E_OEg{vi$DIdLNPHIk& z@-lgRyzzWXN{cP6zkx9@japLPTIL~8qR1Im0T)+2R{NiVM%)o=9Tf?fzBe9)K+_aJ z(`Xis8VVAq3KXi4Xi^}Ag!vy2dA*PkkXat|^_s&53M_mn>7_ee)hT77eX9bfs}dp% znnu`FV-0vyzS$NC{_9=#$YMo$PML{`FVy*bIm>NWi+Jw?LW~h2z)~U%WaXf4mLkYh z5Rwh?4j_Us$*GdV-*o{ZU2aKr6x1l9MhL)z0L|Lcc4ZML+u zwSx3nI88A_HK$Dm(P&z+Wb^h-`K*&Pgd~vp&6?E8?4E>@A0czZFK;{X)YpVI6)ovy z?7p9=lxeD3EVlv80EN<~qDaT03PGD(?ReN6mN5%Hz$*2QogtrJ%>(750%d z$Is)VB6bnb& zIs}59C(y7AC8De=CP2k)$V2gAR7HLQbM*hR{td1iL)aO1wftHmF$7cc51%Rej`)YP>&hjwldq0Ca*sW6@f%Jb-g_D zb5&z=R)RG53@(jKqgz!L@uKqG($?51&R#goWU!>sbxCCQl&d+8!KD zbUP92)^IAZTQR_tWwa6wCacLPHU%evd1wxq4Ya|&t?oK!(ikQGkCF`R-XqAvi;tti z-=sQYD;V+qh;{poqMi3wIT(Q9XjLl&D-;4(lo(8FFi3GLYY*ES7hj^<<7=VIk2knx z2sH1(RHs$OR(A9u$BUa8jy$7Rck9>u)CD=ECY)SDh$EwEUg^V^F)Y zLeq0(1+H56;8)=-Y9VY;jK!)?Veu{Xn3oA-AsUL4ai&aH7whG_;RkE6S;34texpEL zR|&XAE@}Otbcx{%j6yhhPk^2zWLOcR3@614nan|O)xfR@kHT~jFFm5cx3+ zp~uC=4E&SXJdF+Ht}t^cR}xWzWKmO4Oluv)Ag%=T_9X1G}2G?U1~ovQC_JzE4LnMjrFnp5I*7kp|vMO~jgOT*mE%(B$(p}0^6Q08Euy`dcM+AQJXTxzL86s zE322ThL$TWatY^O7O@^e>j?+iS9{D;ZXkQ6H^&&Z`g2)Iht`N)O*JOT+MtUy5X`IG zcwBdF@zJn|dbz2$D=8!t)F9PZZ5kmnK-h_+SN$P z$`PlqT@gRV6tFP`E@iFdOmI%8bMu z%zzML+G>k^$+oz0A@u{ujYn;rnio)p)V*8lR-?|Vd#jA^Dpz(BQ??X{iW6(~quXOW zt5&Pllyl)OYP?*c25i})$4I_iTB)Co&As$iR`4@w`Yb8vGU(Y(e7|IHhPi4iikZ~p zYO{4!PZ2ALcBbX*DGet?VOc69n@guH5~jlYin1<|b94?6I7kc?LX3e%@c)asBAh5l IYTy?GfTFY+Pyhe` diff --git a/SESSION.md b/SESSION.md index 97445267..756f93cd 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-10-30 | +|date |2025-10-31 | |rstudio |2025.05.0+496 Mariposa Orchid (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |quarto |1.7.30 @ /usr/local/bin/quarto | -|FreesearchR |25.10.5.251030 | +|FreesearchR |25.10.5.251031 | -------------------------------------------------------------------------------- @@ -118,12 +118,15 @@ |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) | |keyring |1.4.1 |2025-06-15 |CRAN (R 4.4.1) | |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 |RSPM (R 4.4.0) | |lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) | |lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | +|litedown |0.7 |2025-04-08 |CRAN (R 4.4.1) | |lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | |lubridate |1.9.4 |2024-12-08 |CRAN (R 4.4.1) | |magrittr |2.0.3 |2022-03-30 |RSPM (R 4.4.0) | +|markdown |2.0 |2025-03-23 |CRAN (R 4.4.1) | |MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) | |Matrix |1.7-3 |2025-03-11 |RSPM (R 4.4.0) | |memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | @@ -225,6 +228,7 @@ |uuid |1.2-1 |2024-07-29 |CRAN (R 4.4.1) | |V8 |6.0.6 |2025-08-18 |CRAN (R 4.4.1) | |vctrs |0.6.5 |2023-12-01 |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/man/compare_missings.Rd b/man/compare_missings.Rd index 8950200c..d7c412d0 100644 --- a/man/compare_missings.Rd +++ b/man/compare_missings.Rd @@ -4,7 +4,7 @@ \alias{compare_missings} \title{Pairwise comparison of missings across covariables} \usage{ -compare_missings(data, by_var) +compare_missings(data, by_var, max_level = 20) } \arguments{ \item{data}{data frame} diff --git a/man/split-string.Rd b/man/split-string.Rd new file mode 100644 index 00000000..7bf65a68 --- /dev/null +++ b/man/split-string.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/separate_string.R +\name{split-string} +\alias{split-string} +\alias{string_split_ui} +\alias{string_split_server} +\alias{modal_string_split} +\title{String split module based on tidyr::separate_} +\usage{ +string_split_ui(id) + +string_split_server(id, data_r = reactive(NULL)) + +modal_string_split( + id, + title = i18n$t("Split character string"), + easyClose = TRUE, + size = "xl", + footer = NULL +) +} +\arguments{ +\item{id}{id} + +\item{data_r}{reactive data} + +\item{title}{Modal title} + +\item{easyClose}{easyClose} + +\item{size}{size} + +\item{footer}{footer} +} +\value{ +A shiny ui module + +shiny module server + +shiny modal +} +\description{ +String split module based on tidyr::separate_ +} From 653424692d60a63be4135942037da9082c570ada Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 31 Oct 2025 12:02:43 +0100 Subject: [PATCH 12/12] new release --- R/data_plots.R | 44 +- R/plot_bar.R | 11 +- app_docker/app.R | 850 ++++++++++++++++++--- app_docker/translations/translation_da.csv | 55 +- app_docker/translations/translation_de.csv | 21 +- app_docker/translations/translation_sv.csv | 293 +++++++ app_docker/translations/translation_sw.csv | 21 +- inst/apps/FreesearchR/app.R | 850 ++++++++++++++++++--- 8 files changed, 1931 insertions(+), 214 deletions(-) create mode 100644 app_docker/translations/translation_sv.csv diff --git a/R/data_plots.R b/R/data_plots.R index 24024b15..fcb63ea4 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -498,6 +498,28 @@ subset_types <- function(data, types, type.fun = data_type) { #' supported_plots() |> str() supported_plots <- function() { list( + plot_bar_rel = list( + fun = "plot_bar", + fun.args =list(style="fill"), + descr = i18n$t("Stacked relative barplot"), + note = i18n$t("Create relative stacked barplots to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = NULL + ), + plot_bar_abs = list( + fun = "plot_bar", + fun.args =list(style="dodge"), + descr = i18n$t("Side-by-side barplot"), + note = i18n$t("Create side-by-side barplot to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = "none" + ), plot_hbars = list( fun = "plot_hbars", descr = i18n$t("Stacked horizontal bars"), @@ -566,28 +588,6 @@ supported_plots <- function() { secondary.max = 4, tertiary.type = c("dichotomous"), secondary.extra = NULL - ), - plot_bar_rel = list( - fun = "plot_bar", - fun.args =list(style="fill"), - descr = i18n$t("Stacked relative barplot"), - note = i18n$t("Create relative stacked barplots to show the distribution of categorical levels"), - primary.type = c("dichotomous", "categorical"), - secondary.type = c("dichotomous", "categorical"), - secondary.multi = FALSE, - tertiary.type = c("dichotomous", "categorical"), - secondary.extra = NULL - ), - plot_bar_abs = list( - fun = "plot_bar", - fun.args =list(style="dodge"), - descr = i18n$t("Side-by-side barplot"), - note = i18n$t("Create side-by-side barplot to show the distribution of categorical levels"), - primary.type = c("dichotomous", "categorical"), - secondary.type = c("dichotomous", "categorical"), - secondary.multi = FALSE, - tertiary.type = c("dichotomous", "categorical"), - secondary.extra = "none" ) ) } diff --git a/R/plot_bar.R b/R/plot_bar.R index 5602269f..4e76550d 100644 --- a/R/plot_bar.R +++ b/R/plot_bar.R @@ -99,12 +99,14 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", " ggplot2::geom_bar(position = style, stat = "identity") + ggplot2::scale_y_continuous(labels = scales::percent) + ggplot2::ylab("Percentage") + - ggplot2::xlab(get_label(data,pri)) + ggplot2::xlab(get_label(data,pri))+ + ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data,fill))) ## To handle large number of levels and long level names + if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) { p <- p + - ggplot2::guides(fill = "none") + + # ggplot2::guides(fill = "none") + ggplot2::theme( axis.text.x = ggplot2::element_text( angle = 90, @@ -113,6 +115,11 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", " ggplot2::theme( axis.text.x = ggplot2::element_text(vjust = 0.5) ) + + if (is.null(sec)){ + p <- p + + ggplot2::guides(fill = "none") + } } p } diff --git a/app_docker/app.R b/app_docker/app.R index 7de83f97..21c246e1 100644 --- a/app_docker/app.R +++ b/app_docker/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//Rtmp5UwPqh/filef21e3b42c1c3.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpigVRui/file787d121e91b3.R ######## i18n_path <- here::here("translations") @@ -62,7 +62,7 @@ i18n$set_translation_language("en") #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'25.10.4' +app_version <- function()'25.10.5' ######## @@ -424,35 +424,6 @@ create_column_ui <- function(id) { 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() - # tags$style(HTML(" - # /* modified from esquisse for data types */ - # .btn-column-categorical { - # background-color: #EF562D; - # color: #FFFFFF; - # } - # .btn-column-continuous { - # background-color: #0C4C8A; - # color: #FFFFFF; - # } - # .btn-column-dichotomous { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-datetime { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-id { - # background-color: #848484; - # color: #FFFFFF; - # } - # .btn-column-text { - # background-color: #2E2E2E; - # color: #FFFFFF; - # }")) - # ), fluidRow( column( width = 6, @@ -1216,9 +1187,16 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other = tbl <- sort(table(x), decreasing = TRUE) if (type == "top") { + if (length(levels(x)) <= breaks){ + return(x) + } lvls <- names(tbl[seq_len(breaks)]) } else if (type == "bottom") { - lvls <- names(tbl)[!tbl / NROW(x) * 100 < breaks] + freqs_check <- tbl / NROW(x) * 100 < breaks + if (!any(freqs_check)){ + return(x) + } + lvls <- names(tbl)[!freqs_check] } if (other %in% lvls) { @@ -1312,14 +1290,7 @@ cut_variable_ui <- function(id) { ), column( width = 3, - numericInput( - inputId = ns("n_breaks"), - label = i18n$t("Number of breaks:"), - value = 3, - min = 2, - max = 12, - width = "100%" - ) + shiny::uiOutput(ns("n_breaks")) ), column( width = 3, @@ -1400,8 +1371,38 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # ) }), data_r(), input$hidden) + output$n_breaks <- shiny::renderUI({ + req(input$method) + # req(!is.null(get_list_elements(name = input$cut_method,element = "breaks"))) + # browser() + + break_text <- get_list_elements(name = input$method, element = "breaks") + + if (is.null(get_list_elements(name = input$method, element = "min"))) { + min <- 2 + } else { + min <- get_list_elements(name = input$method, element = "min") + } + + if (is.null(get_list_elements(name = input$method, element = "max"))) { + max <- 10 + } else { + max <- get_list_elements(name = input$method, element = "max") + } + + numericInput( + inputId = ns("n_breaks"), + label = break_text, + value = 3, + min = min, + max = max, + width = "100%" + ) + }) + output$slider_fixed <- renderUI({ data <- req(data_r()) + req(input$n_breaks) variable <- req(input$variable) req(hasName(data, variable)) @@ -1491,13 +1492,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { choices <- unique(choices) - ## Implement labeled vector selection of cut methods to include descriptions - ## - ## cut_methods() - ## - - - vectorSelectInput( inputId = ns("method"), label = i18n$t("Method:"), @@ -1505,14 +1499,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { selected = NULL, width = "100%" ) - - # shinyWidgets::virtualSelectInput( - # inputId = session$ns("method"), - # label = i18n$t("Method:"), - # choices = choices, - # selected = NULL, - # width = "100%" - # ) }) @@ -1665,6 +1651,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) + count_data <- as.data.frame( table( breaks = data[[length(data)]], @@ -1672,6 +1659,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ), responseName = "count" ) + count_data$freq <- paste(signif(count_data$count / nrow(data) * 100, 3), "%") + # browser() gridTheme <- getOption("datagrid.theme") if (length(gridTheme) < 1) { datamods:::apply_grid_theme() @@ -1679,7 +1668,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { on.exit(toastui::reset_grid_theme()) grid <- toastui::datagrid( data = count_data, - colwidths = "guess", + colwidths = "fit", theme = "default", bodyHeight = "auto" ) @@ -1767,55 +1756,63 @@ cut_methods <- function() { "hour" = list( descr = i18n$t("Hour of the day"), # class = c("hms", "POSIXct"), # Not implemented yet, but will during rewrite at some point... - breaks = i18n$t("Breaks") + breaks = NULL ), "day" = list( descr = i18n$t("By day of the week"), - breaks = i18n$t("Breaks") + breaks = NULL ), "weekday" = list( descr = i18n$t("By weekday"), - breaks = i18n$t("Breaks") + breaks = NULL ), "week" = list( descr = i18n$t("By week number and year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "week_only" = list( descr = i18n$t("By week number"), - breaks = i18n$t("Breaks") + breaks = NULL ), "month" = list( descr = i18n$t("By month and year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "month_only" = list( descr = i18n$t("By month only"), - breaks = i18n$t("Breaks") + breaks = NULL ), "quarter" = list( descr = i18n$t("By quarter of the year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "year" = list( descr = i18n$t("By year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "top" = list( descr = i18n$t("Keep only most common"), - breaks = i18n$t("Number") + breaks = i18n$t("Number"), + min = 1, + max = 20 ), "bottom" = list( descr = i18n$t("Combine below percentage"), - breaks = i18n$t("Percentage") + breaks = i18n$t("Percentage"), + min = 1, + max = 50 ), "fixed" = list( descr = i18n$t("By specified numbers"), - breaks = i18n$t("Breaks") + breaks = i18n$t("Breaks"), + min = 2, + max = 12 ), "quantile" = list( descr = i18n$t("By quantiles (groups of equal size)"), - breaks = i18n$t("Breaks") + breaks = i18n$t("Breaks"), + min = 2, + max = 10 ) ) } @@ -1836,9 +1833,13 @@ cut_methods <- function() { #' @examples #' get_list_elements(c("top", "bottom"), "descr") get_list_elements <- function(name, element, dict = cut_methods()) { - sapply(dict[name], \(.x){ - .x[[element]] - }) + if (is.null(name)) { + return(NULL) + } else { + sapply(dict[name], \(.x){ + .x[[element]] + }) + } } #' Set values as names and names as values @@ -2204,6 +2205,12 @@ data_visuals_server <- function(id, ter = input$tertiary ) + ## If the dictionary holds additional arguments to pass to the + ## plotting function, these are included + if (!is.null(rv$plot.params()[["fun.args"]])){ + parameters <- modifyList(parameters,rv$plot.params()[["fun.args"]]) + } + shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."), { rv$plot <- rlang::exec( create_plot, @@ -2353,6 +2360,28 @@ subset_types <- function(data, types, type.fun = data_type) { #' supported_plots() |> str() supported_plots <- function() { list( + plot_bar_rel = list( + fun = "plot_bar", + fun.args =list(style="fill"), + descr = i18n$t("Stacked relative barplot"), + note = i18n$t("Create relative stacked barplots to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = NULL + ), + plot_bar_abs = list( + fun = "plot_bar", + fun.args =list(style="dodge"), + descr = i18n$t("Side-by-side barplot"), + note = i18n$t("Create side-by-side barplot to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = "none" + ), plot_hbars = list( fun = "plot_hbars", descr = i18n$t("Stacked horizontal bars"), @@ -2367,7 +2396,7 @@ supported_plots <- function() { fun = "plot_violin", descr = i18n$t("Violin plot"), note = i18n$t("A modern alternative to the classic boxplot to visualise data distribution"), - primary.type = c("datatime", "continuous", "dichotomous", "categorical"), + primary.type = c("datatime", "continuous"), secondary.type = c("dichotomous", "categorical"), secondary.multi = FALSE, secondary.extra = "none", @@ -2405,7 +2434,7 @@ supported_plots <- function() { fun = "plot_box", descr = i18n$t("Box plot"), note = i18n$t("A classic way to plot data distribution by groups"), - primary.type = c("datatime", "continuous", "dichotomous", "categorical"), + primary.type = c("datatime", "continuous"), secondary.type = c("dichotomous", "categorical"), secondary.multi = FALSE, tertiary.type = c("dichotomous", "categorical"), @@ -4245,7 +4274,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.10.4-251027' +hosted_version <- function()'v25.10.5-251031' ######## @@ -5360,6 +5389,7 @@ data_missings_ui <- function(id) { data_missings_server <- function(id, data, variable, + max_level=20, ...) { shiny::moduleServer( id = id, @@ -5380,7 +5410,7 @@ data_missings_server <- function(id, tryCatch( { - out <- compare_missings(df_tbl,by_var) + out <- compare_missings(df_tbl,by_var,max_level = max_level) }, error = function(err) { showNotification(paste0("Error: ", err), type = "err") @@ -5469,8 +5499,18 @@ missing_demo_app() #' @returns gtsummary list object #' @export #' -compare_missings <- function(data,by_var){ +compare_missings <- function(data,by_var,max_level=20){ if (!is.null(by_var) && by_var != "" && by_var %in% names(data)) { + data <- data |> + lapply(\(.x){ + # browser() + if (is.factor(.x)){ + cut_var(.x,breaks=20,type="top") + } else { + .x + } + }) |> dplyr::bind_cols() + data[[by_var]] <- ifelse(is.na(data[[by_var]]), "Missing", "Non-missing") out <- gtsummary::tbl_summary(data, by = by_var) |> @@ -5482,6 +5522,137 @@ compare_missings <- function(data,by_var){ } +######## +#### Current file: /Users/au301842/FreesearchR/R//plot_bar.R +######## + +plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"), max_level = 30, ...) { + style <- match.arg(style) + + if (!is.null(ter)) { + ds <- split(data, data[ter]) + } else { + ds <- list(data) + } + + out <- lapply(ds, \(.ds){ + plot_bar_single( + data = .ds, + pri = pri, + sec = sec, + style = style, + max_level = max_level + ) + }) + + wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...) +} + + +#' Single vertical barplot +#' +#' @param style barplot style passed to geom_bar position argument. +#' One of c("stack", "dodge", "fill") +#' +#' @name data-plots +#' +#' @returns ggplot object +#' @export +#' +#' @examples +#' mtcars |> +#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> +#' plot_bar_single(pri = "cyl", sec = "am", style = "fill") +#' +#' mtcars |> +#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> +#' plot_bar_single(pri = "cyl", style = "stack") +plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30) { + style <- match.arg(style) + + if (identical(sec, "none")) { + sec <- NULL + } + + p_data <- as.data.frame(table(data[c(pri, sec)])) |> + dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor), + p = Freq / NROW(data) + ) + + + if (nrow(p_data) > max_level) { + # browser() + p_data <- sort_by( + p_data, + p_data[["Freq"]], + decreasing = TRUE + ) |> + head(max_level) + # if (is.null(sec)){ + # p_data <- sort_by( + # p_data, + # p_data[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # } else { + # split(p_data,p_data[[sec]]) |> + # lapply(\(.x){ + # # browser() + # sort_by( + # .x, + # .x[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # }) |> dplyr::bind_rows() + # } + } + + ## Shortens long level names + p_data[[pri]] <- forcats::as_factor(unique_short(as.character(p_data[[pri]]), max = 20)) + + if (!is.null(sec)) { + fill <- sec + } else { + fill <- pri + } + + p <- ggplot2::ggplot( + p_data, + ggplot2::aes( + x = .data[[pri]], + y = p, + fill = .data[[fill]] + ) + ) + + ggplot2::geom_bar(position = style, stat = "identity") + + ggplot2::scale_y_continuous(labels = scales::percent) + + ggplot2::ylab("Percentage") + + ggplot2::xlab(get_label(data,pri))+ + ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data,fill))) + + ## To handle large number of levels and long level names + + if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) { + p <- p + + # ggplot2::guides(fill = "none") + + ggplot2::theme( + axis.text.x = ggplot2::element_text( + angle = 90, + vjust = 1, hjust = 1 + ))+ + ggplot2::theme( + axis.text.x = ggplot2::element_text(vjust = 0.5) + ) + + if (is.null(sec)){ + p <- p + + ggplot2::guides(fill = "none") + } + } + p +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//plot_box.R ######## @@ -5527,8 +5698,6 @@ plot_box <- function(data, pri, sec, ter = NULL,...) { } - - #' Create nice box-plots #' #' @name data-plots @@ -8744,6 +8913,462 @@ modify_qmd <- function(file, format) { +######## +#### Current file: /Users/au301842/FreesearchR/R//separate_string.R +######## + +#' String split module based on tidyr::separate_ +#' +#' @param id id +#' +#' @returns A shiny ui module +#' @export +#' +#' @name split-string +#' +string_split_ui <- function(id) { + ns <- NS(id) + tagList( + shiny::fluidRow( + # shiny::textOutput(outputId = ns("no_splits")), + column( + width = 4, + shiny::uiOutput(outputId = ns("variable")) + ), + column( + width = 4, + shiny::uiOutput(outputId = ns("delim")) + ), + column( + width = 4, + shiny::uiOutput(outputId = ns("direction")) + ) # , + # column( + # width = 3, + # actionButton( + # inputId = ns("split"), + # label = tagList(phosphoricons::ph("scissors"), i18n$t("Split the variable")), + # class = "btn-outline-primary float-end" + # ) + # ) + ), + shiny::fluidRow( + column( + width = 4, + shiny::h4(i18n$t("Original data")), + toastui::datagridOutput2(outputId = ns("orig_data")) + # DT::DTOutput(outputId = ns("orig_data_3")) + # This doesn't render... + # toastui::datagridOutput2(outputId = ns("orig_data_2")) + ), + column( + width = 8, + shiny::h4(i18n$t("Preview of result")), + toastui::datagridOutput2(outputId = ns("new_data")) + ) + ), + actionButton( + inputId = ns("create"), + label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")), + class = "btn-outline-primary float-end" + ), + tags$div(class = "clearfix") + ) +} + + + +#' @param data_r reactive data +#' +#' @returns shiny module server +#' @export +#' +#' @name split-string +#' +string_split_server <- function(id, data_r = reactive(NULL)) { + moduleServer( + id, + function(input, output, session) { + rv <- reactiveValues(data = NULL, target=NULL, temp = NULL, out=NULL) + + ns <- session$ns + + # output$no_splits <- shiny::renderText({ + # req({ + # data_r() + # }) + # + # if (any(is_splittable(data_r()))) { + # i18n$t("No character variables with accepted delimiters detected.") + # } + # }) + + shiny::observe({ + req(data_r()) + + # if (any(is_splittable(data_r()))) { + data <- data_r() + rv$data <- data + + vars_num <- vapply(data, \(.x){ + is_splittable(.x) + }, logical(1)) + vars_num <- names(vars_num)[vars_num] + + req(length(vars_num)>0) + + output$variable <- shiny::renderUI( + columnSelectInput( + inputId = ns("variable"), + data = data, + label = i18n$t("Variable to split:"), + width = "100%", + col_subset = vars_num, + selected = if (isTruthy(input$variable)) input$variable else vars_num[1] + ) + ) + # } + # shinyWidgets::updateVirtualSelect( + # inputId = "variable", + # choices = vars_num, + # selected = if (isTruthy(input$variable)) input$variable else vars_num[1] + # ) + }) + + output$delim <- shiny::renderUI({ + req(rv$data) + req(input$variable) + # browser() + + req(input$variable %in% names(rv$data)) + # req({ + # any(apply(data_r(),2,is_splittable)) + # }) + # if (any(is_splittable(data_r()))) { + data <- rv$data |> + dplyr::select(tidyselect::all_of(input$variable)) + + delimiters <- Reduce(c, unique(sapply(data[[1]], detect_delimiter))) + + # shiny::textInput(inputId = ns("delim"), label = i18n$t("Text or character to split string by")) + shiny::selectInput( + inputId = ns("delim"), label = i18n$t("Select delimiter"), + choices = setNames( + delimiters, + glue::glue("'{delimiters}'") + ), selected = 1 + ) + # } + }) + + + output$direction <- shiny::renderUI({ + # req({ + # rv$data + # }) + + # if (any(is_splittable(data_r()))) { + vectorSelectInput( + inputId = ns("direction"), + label = i18n$t("Direction:"), + choices = setNames( + c( + "wide", + "long" + ), + c( + i18n$t("Split string to multiple columns. Keep number of rows."), + i18n$t("Split string to multiple observations (rows) in the same column. Also ads id and instance columns") + ) + ), + selected = "wide", + width = "100%" + ) + # } + }) + + observeEvent( + list( + input$variable, + input$delim, + input$direction + ), + { + req(rv$data) + req(input$variable) + req(input$delim) + req(input$direction) + + data <- rv$data |> + dplyr::select(tidyselect::all_of(input$variable)) + # browser() + rv$temp <- separate_string( + data = data, + col = input$variable, + delim = input$delim, + direction = input$direction + ) + } + ) + + # shiny::observeEvent(input$split, { + # show_data(rv$temp, title = i18n$t("Browse data preview"), type = "modal") + # }) + + ## Toastui would not render the original data, so the solution was to go + ## with native table rendering, which works, but doesn't please the eye + + # output$orig_data <- shiny::renderTable({ + # req(data_r()) + # req(input$variable) + # data <- data_r() |> + # dplyr::select(tidyselect::all_of(input$variable)) + # # browser() + # head(data, 10) + # }) + + output$orig_data <- toastui::renderDatagrid2({ + req(data_r()) + req(input$variable) + + req(hasName(rv$data, input$variable)) + + data <- data_r() |> + dplyr::select(tidyselect::all_of(input$variable)) |> + head(30) |> + dplyr::mutate(row=dplyr::row_number()) |> + dplyr::select(row,tidyselect::everything()) + # browser() + toastui::datagrid( + data = data, + rowHeight = 40, + colwidths = "guess", + theme = "default", + bodyHeight = "auto", + pagination = 10) + }) + + output$new_data <- toastui::renderDatagrid2({ + shiny::req(rv$temp) + data <- rv$temp + toastui::datagrid( + data = head(data, 30), + rowHeight = 40, + colwidths = "guess", + theme = "default", + bodyHeight = "auto", pagination = 10 + ) + }) + + data_split_r <- reactive({ + req(rv$temp) + + data <- rv$data + + parameters <- list( + col = input$variable, + delim = input$delim, + direction = input$direction + ) + + out <- tryCatch({ + rlang::exec(separate_string, !!!modifyList( + parameters, + list( + data = data + ) + )) + }) + # browser() + + # separate_string( + # data = data, + # + # ) + + code <- rlang::call2( + "separate_string", + !!!parameters, + .ns = "FreesearchR" + ) + attr(out, "code") <- code + out}) + + data_returned_r <- observeEvent(input$create, { + rv$out <- data_split_r() + }) + + return(reactive(rv$out)) + } + ) +} + + +#' @param title Modal title +#' @param easyClose easyClose +#' @param size size +#' @param footer footer +#' +#' @returns shiny modal +#' @export +#' +#' @name split-string +modal_string_split <- function(id, + title = i18n$t("Split character string"), + easyClose = TRUE, + size = "xl", + footer = NULL) { + ns <- NS(id) + showModal(modalDialog( + title = tagList(title, datamods:::button_close_modal()), + string_split_ui(id), + tags$div( + style = "display: none;", + textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) + ), + easyClose = easyClose, + size = size, + footer = footer + )) +} + + +### Helpers + +#' Separate string wide or long +#' +#' @param data data +#' @param col column +#' @param delim delimiter +#' @param direction target direction +#' +#' @returns data.frame +#' @export +#' +separate_string <- function(data, col, delim, direction = c("wide", "long")) { + direction <- match.arg(direction) + + if (direction == "long") { + out <- data |> + dplyr::mutate(id_str_split = dplyr::row_number()) |> + dplyr::group_by_at("id_str_split") |> + tidyr::separate_longer_delim(cols = tidyselect::all_of(col), delim = delim) |> + dplyr::mutate(instance_str_split = dplyr::row_number()) |> + # add_instance(by="id") + dplyr::ungroup() |> + dplyr::mutate(dplyr::across(tidyselect::matches(col), trimws)) + } else if (direction == "wide") { + ## Experiment of wide to long + + out <- data |> + tidyr::separate_wider_delim( + cols = tidyselect::all_of(col), + delim = delim, + names_sep = "_", + too_few = "align_start" + ) |> + dplyr::mutate(dplyr::across(tidyselect::starts_with(col), trimws)) + } + + out +} + + + +#' Detect delimiters in string based on allowed delimiters +#' +#' @description +#' Accepts any repeat of delimiters and includes surrounding whitespace +#' +#' +#' @param text character vector +#' @param delimiters allowed delimiters +#' +#' @returns character vector +#' @export +#' +#' @examples +#' sapply(c("Walk - run", "Sel__Re", "what;now"), detect_delimiter) +detect_delimiter <- function(data, delimiters = c("_", "-", ";", "\n", ",")) { + # Create patterns for each delimiter with potential surrounding whitespace + patterns <- paste0("\\s*\\", delimiters, "+\\s*") + + # Check each pattern + out <- sapply(patterns, \(.x){ + if (grepl(.x, data)) { + # Extract the actual matched delimiter with whitespace + regmatches(data, regexpr(.x, data)) + } + }) + + Reduce(c, out) +} + + +#' Determine if any variable in data frame character and contains recognized delimiters +#' +#' @param data vector or data.frame +#' +#' @returns logical +#' @export +#' +#' @examples +#' any(apply(mtcars, 2, is_splittable)) +#' is_splittable(mtcars) +is_splittable <- function(data) { + if (is.data.frame(data)) { + return(apply(data, 2, is_splittable)) + } + + if (is.character(data)) { + if (length(Reduce(c, unique(sapply(data, detect_delimiter)))) > 0) { + TRUE + } else { + FALSE + } + } else { + FALSE + } +} + +# mtcars |> simple_dt() +simple_dt <- function(data,...){ + headerCallbackRemoveHeaderFooter <- c( + "function(thead, data, start, end, display){", + " $('th', thead).css('display', 'none');", + "}" + ) + + DT::datatable( + data, + options = list( + dom = "t", + ordering = FALSE, + paging = FALSE, + searching = FALSE, + # headerCallback = DT::JS(headerCallbackRemoveHeaderFooter), + columnDefs = list( + list( + targets = 1, + render = DT::JS( + "function(data, type, row, meta) {", + "return type === 'display' && data.length > 10 ?", + "'' + data.substr(0, 10) + '...' : data;", + "}"))) + ), + selection = 'none', + callback = DT::JS( + "$('table.dataTable.no-footer').css('border-bottom', 'none');" + ), + class = 'row-border', + escape = FALSE, + rownames = FALSE, + # width = 500, + filter = "none" + ) +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//syntax_highlight.R ######## @@ -9013,7 +9638,7 @@ ui_elements <- function(selection) { import_globalenv_ui( id = "env", title = NULL, - packages = c("NHANES", "stRoke", "datasets") + packages = c("NHANES", "stRoke", "datasets", "MASS") ) ), # shiny::conditionalPanel( @@ -9182,7 +9807,7 @@ ui_elements <- function(selection) { shiny::tags$br(), shiny::fluidRow( shiny::column( - width = 4, + width = 3, shiny::actionButton( inputId = "modal_update", label = i18n$t("Reorder factor levels"), @@ -9194,7 +9819,7 @@ ui_elements <- function(selection) { shiny::tags$br() ), shiny::column( - width = 4, + width = 3, shiny::actionButton( inputId = "modal_cut", label = i18n$t("New factor"), @@ -9206,7 +9831,19 @@ ui_elements <- function(selection) { shiny::tags$br() ), shiny::column( - width = 4, + width = 3, + shiny::actionButton( + inputId = "modal_string", + label = i18n$t("Split text"), + width = "100%" + ), + shiny::tags$br(), + shiny::helpText(i18n$t("Split a text column by a recognised delimiter.")), + shiny::tags$br(), + shiny::tags$br() + ), + shiny::column( + width = 3, shiny::actionButton( inputId = "modal_column", label = i18n$t("New variable"), @@ -12031,7 +12668,7 @@ server <- function(input, output, session) { }) ## Activating action buttons on data imported - shiny::observeEvent(rv$data_original, { + shiny::observeEvent(list(rv$data_original, rv$data), { if (is.null(rv$data_original) | NROW(rv$data_original) == 0) { shiny::updateActionButton(inputId = "act_start", disabled = TRUE) shiny::updateActionButton(inputId = "modal_browse", disabled = TRUE) @@ -12051,6 +12688,16 @@ server <- function(input, output, session) { } }) + shiny::observeEvent(list(rv$data_original, rv$data), { + if (is.null(rv$data_original) | NROW(rv$data_original) == 0 | is.null(rv$data) | !any(is_splittable(rv$data))) { + shiny::updateActionButton(inputId = "modal_string", disabled = TRUE) + } else if (!is.null(rv$data) && any(is_splittable(rv$data))) { + shiny::updateActionButton(inputId = "modal_string", disabled = FALSE) + } + }) + + + ############################################################################## ######### ######### Data modification section @@ -12142,6 +12789,29 @@ server <- function(input, output, session) { rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") }) + ######### Split string + + shiny::observeEvent( + input$modal_string, + modal_string_split( + id = "modal_string", + title = i18n$t("Split a character string by a common delimiter") + ) + ) + + data_modal_string <- string_split_server( + id = "modal_string", + data_r = reactive(rv$data) + ) + + shiny::observeEvent( + data_modal_string(), + { + rv$data <- data_modal_string() + rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") + } + ) + ######### Create column shiny::observeEvent( @@ -12579,6 +13249,16 @@ server <- function(input, output, session) { add.overall = TRUE ) + ## Limits maximum number of levels included in baseline table to 20. + data <- rv$list$data |> + lapply(\(.x){ + # browser() + if (is.factor(.x)){ + cut_var(.x,breaks=20,type="top") + } else { + .x + } + }) |> dplyr::bind_cols() # Attempt to introduce error on analysing too large dataset # tryCatch( @@ -12589,7 +13269,7 @@ server <- function(input, output, session) { # print("Please limit to 100.") # } else { shiny::withProgress(message = i18n$t("Creating the table. Hold on for a moment.."), { - rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data, parameters, "data")) + rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(data, parameters, "data")) }) # } # }, diff --git a/app_docker/translations/translation_da.csv b/app_docker/translations/translation_da.csv index a65f4de4..22cafcfa 100644 --- a/app_docker/translations/translation_da.csv +++ b/app_docker/translations/translation_da.csv @@ -49,7 +49,6 @@ "Column added!","Variabel oprettet!" "Unique values:","Unikke værdier:" "Variable to cut:","Variabel, der skal deles:" -"Number of breaks:","Antal niveauer:" "Close intervals on the right","Luk intervaller til højre" "Include lowest value","Inkluderer den laveste værdi" "Create factor variable","Opret kategorisk variabel" @@ -255,20 +254,40 @@ "Choose a name for the column to be created or modified, then enter an expression before clicking on the button below to create the variable, or cancel to exit without saving anything.","Vælg et navn til den nye variabel, skriv din formel og tryk så på knappen for at gemme variablen, eller annuler for at lukke uden at gemme." "Please fill in web address and API token, then press 'Connect'.","Udfyld serveradresse og API-nøgle, og tryk så 'Fobind'." "Other","Other" -"Hour of the day","Hour of the day" -"Breaks","Breaks" -"By day of the week","By day of the week" -"By weekday","By weekday" -"By week number and year","By week number and year" -"By month and year","By month and year" -"By month only","By month only" -"By quarter of the year","By quarter of the year" -"By year","By year" -"Keep only most common","Keep only most common" -"Number","Number" -"Combine below percentage","Combine below percentage" -"Percentage","Percentage" -"By specified numbers","By specified numbers" -"By quantiles (groups of equal size)","By quantiles (groups of equal size)" -"By week number","By week number" -"There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Hour of the day","Time på dagen" +"Breaks","Grupper" +"By day of the week","Efter ugedag" +"By weekday","Efter ugedag" +"By week number and year","Efter ugenummer og årstal" +"By month and year","Efter måned og årstal" +"By month only","Efter måned alene" +"By quarter of the year","Efter kvartal" +"By year","Efter år" +"Keep only most common","Behold kun de hyppigste" +"Number","Antal" +"Combine below percentage","Kombiner under procentsats" +"Percentage","Procentsats" +"By specified numbers","Efter specifikke værdier" +"By quantiles (groups of equal size)","I grupper af samme størrelse" +"By week number","Efter ugenummer alene" +"There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","Der er mere avancerede muligheder for at ændre kategoriske variable, oprette nye kategoriske variabler fra eksisterende data eller nye variable baseret på R-kode. Nederst kan du gendanne originale data." +"Split the variable","Split the variable" +"Original data","Original data" +"Preview of result","Preview of result" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Variable to split:","Variable to split:" +"Text or character to split string by","Text or character to split string by" +"Select delimiter","Select delimiter" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Browse data preview","Browse data preview" +"Split character string","Split character string" +"Split text","Split text" +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." +"Split a character string by a common delimiter","Split a character string by a common delimiter" +"Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" diff --git a/app_docker/translations/translation_de.csv b/app_docker/translations/translation_de.csv index 450ccbe0..d8947867 100644 --- a/app_docker/translations/translation_de.csv +++ b/app_docker/translations/translation_de.csv @@ -18,7 +18,6 @@ "Column added!","Column added!" "Unique values:","Unique values:" "Variable to cut:","Variable to cut:" -"Number of breaks:","Number of breaks:" "Close intervals on the right","Close intervals on the right" "Include lowest value","Include lowest value" "Create factor variable","Create factor variable" @@ -272,3 +271,23 @@ "Generating the report. Hold on for a moment..","Generating the report. Hold on for a moment.." "We encountered the following error creating your report:","We encountered the following error creating your report:" "There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Text or character to split string by","Text or character to split string by" +"Split the variable","Split the variable" +"Variable to split:","Variable to split:" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Split character string","Split character string" +"Split text","Split text" +"Split a character string by a common delimiter","Split a character string by a common delimiter" +"Select delimiter","Select delimiter" +"Browse data preview","Browse data preview" +"Original data","Original data" +"Preview of result","Preview of result" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." +"Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" diff --git a/app_docker/translations/translation_sv.csv b/app_docker/translations/translation_sv.csv new file mode 100644 index 00000000..b9e18015 --- /dev/null +++ b/app_docker/translations/translation_sv.csv @@ -0,0 +1,293 @@ +"en","sv" +"Hello","Hei" +"The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent.","The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent." +"No variables have a correlation measure above the threshold.","No variables have a correlation measure above the threshold." +"and","and" +"The following error occured on determining correlations:","The following error occured on determining correlations:" +"from each pair","from each pair" +"New column name:","New column name:" +"Group calculation by:","Group calculation by:" +"Enter an expression to define new column:","Enter an expression to define new column:" +"Click on a column name to add it to the expression:","Click on a column name to add it to the expression:" +"Create column","Create column" +"Cancel","Cancel" +"Choose a name for the column to be created or modified, then enter an expression before clicking on the button below to create the variable, or cancel to exit without saving anything.","Choose a name for the column to be created or modified, then enter an expression before clicking on the button below to create the variable, or cancel to exit without saving anything." +"New column name cannot be empty","New column name cannot be empty" +"Create a new column","Create a new column" +"Some operations are not allowed","Some operations are not allowed" +"Column added!","Column added!" +"Unique values:","Unique values:" +"Variable to cut:","Variable to cut:" +"Close intervals on the right","Close intervals on the right" +"Include lowest value","Include lowest value" +"Create factor variable","Create factor variable" +"Fixed breaks:","Fixed breaks:" +"Method:","Method:" +"Other","Other" +"Convert Numeric to Factor","Convert Numeric to Factor" +"Hour of the day","Hour of the day" +"Breaks","Breaks" +"By day of the week","By day of the week" +"By weekday","By weekday" +"By week number and year","By week number and year" +"By week number","By week number" +"By month and year","By month and year" +"By month only","By month only" +"By quarter of the year","By quarter of the year" +"By year","By year" +"Keep only most common","Keep only most common" +"Number","Number" +"Combine below percentage","Combine below percentage" +"Percentage","Percentage" +"By specified numbers","By specified numbers" +"By quantiles (groups of equal size)","By quantiles (groups of equal size)" +"Only non-text variables are available for plotting. Go the ""Data"" to reclass data to plot.","Only non-text variables are available for plotting. Go the ""Data"" to reclass data to plot." +"Plot","Plot" +"Adjust settings, then press ""Plot"".","Adjust settings, then press ""Plot""." +"Plot height (mm)","Plot height (mm)" +"Plot width (mm)","Plot width (mm)" +"File format","File format" +"Download plot","Download plot" +"Create plot","Create plot" +"Download","Download" +"Select variable","Select variable" +"Response variable","Response variable" +"Plot type","Plot type" +"Please select","Please select" +"Additional variables","Additional variables" +"Secondary variable","Secondary variable" +"No variable","No variable" +"Grouping variable","Grouping variable" +"No stratification","No stratification" +"Drawing the plot. Hold tight for a moment..","Drawing the plot. Hold tight for a moment.." +"#Plotting\n","#Plotting\n" +"Stacked horizontal bars","Stacked horizontal bars" +"A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars","A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars" +"Violin plot","Violin plot" +"A modern alternative to the classic boxplot to visualise data distribution","A modern alternative to the classic boxplot to visualise data distribution" +"Sankey plot","Sankey plot" +"A way of visualising change between groups","A way of visualising change between groups" +"Scatter plot","Scatter plot" +"A classic way of showing the association between to variables","A classic way of showing the association between to variables" +"Box plot","Box plot" +"A classic way to plot data distribution by groups","A classic way to plot data distribution by groups" +"Euler diagram","Euler diagram" +"Generate area-proportional Euler diagrams to display set relationships","Generate area-proportional Euler diagrams to display set relationships" +"Unique:","Unique:" +"Missing:","Missing:" +"Most Common:","Most Common:" +"Min:","Min:" +"Mean:","Mean:" +"Median:","Median:" +"Max:","Max:" +"{data_text} has {n} observations and {n_var} variables, with {n_complete} ({p_complete} %) complete cases.","{data_text} has {n} observations and {n_var} variables, with {n_complete} ({p_complete} %) complete cases." +"Import a dataset from an environment","Import a dataset from an environment" +"Select a data source:","Select a data source:" +"Select source","Select source" +"Select a dataset:","Select a dataset:" +"List of datasets...","List of datasets..." +"No data selected!","No data selected!" +"Use a dataset from your environment or from the environment of a package.","Use a dataset from your environment or from the environment of a package." +"No dataset here...","No dataset here..." +"Imported data","Imported data" +"Not a data.frame","Not a data.frame" +"Rows to skip before reading data:","Rows to skip before reading data:" +"Missing values character(s):","Missing values character(s):" +"if several use a comma (',') to separate them","if several use a comma (',') to separate them" +"Decimal separator:","Decimal separator:" +"Encoding:","Encoding:" +"Upload a file:","Upload a file:" +"Browse...","Browse..." +"Select sheet to import:","Select sheet to import:" +"No file selected.","No file selected." +"You can choose between these file types:","You can choose between these file types:" +"You can import {file_extensions_text} files","You can import {file_extensions_text} files" +"First five rows are shown below:","First five rows are shown below:" +"No variable chosen for analysis","No variable chosen for analysis" +"No missing observations","No missing observations" +"Missing vs non-missing observations in the variable **'{variabler()}'**","Missing vs non-missing observations in the variable **'{variabler()}'**" +"Grouped by {get_label(data,ter)}","Grouped by {get_label(data,ter)}" +"Import data from REDCap","Import data from REDCap" +"REDCap server","REDCap server" +"Web address","Web address" +"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'" +"API token","API token" +"The token is a string of 32 numbers and letters.","The token is a string of 32 numbers and letters." +"Connect","Connect" +"Please fill in web address and API token, then press 'Connect'.","Please fill in web address and API token, then press 'Connect'." +"Data import parameters","Data import parameters" +"Select fields/variables to import and click the funnel to apply optional filters","Select fields/variables to import and click the funnel to apply optional filters" +"Import","Import" +"Click to see data dictionary","Click to see data dictionary" +"Connected to server!","Connected to server!" +"The {data_rv$info$project_title} project is loaded.","The {data_rv$info$project_title} project is loaded." +"Data dictionary","Data dictionary" +"Preview:","Preview:" +"Imported data set","Imported data set" +"Select fields/variables to import:","Select fields/variables to import:" +"Specify the data format","Specify the data format" +"Fill missing values?","Fill missing values?" +"Requested data was retrieved!","Requested data was retrieved!" +"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access." +"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access." +"Click to see the imported data","Click to see the imported data" +"Regression table","Regression table" +"Regression","Regression" +"Specify covariables","Specify covariables" +"If none are selected, all are included.","If none are selected, all are included." +"Analyse","Analyse" +"Working...","Working..." +"Press 'Analyse' to create the regression model and after changing parameters.","Press 'Analyse' to create the regression model and after changing parameters." +"Coefficient plot","Coefficient plot" +"Model checks","Model checks" +"Coefficients plot","Coefficients plot" +"Checks","Checks" +"Yes","Yes" +"No","No" +"Show p-value","Show p-value" +"Select outcome variable","Select outcome variable" +"Choose regression analysis","Choose regression analysis" +"Covariables to format as categorical","Covariables to format as categorical" +"Select variable to stratify baseline","Select variable to stratify baseline" +"Select models to plot","Select models to plot" +"Creating regression models failed with the following error:","Creating regression models failed with the following error:" +"Creating a regression table failed with the following error:","Creating a regression table failed with the following error:" +"Saving the plot. Hold on for a moment..","Saving the plot. Hold on for a moment.." +"Running model assumptions checks failed with the following error:","Running model assumptions checks failed with the following error:" +"Select checks to plot","Select checks to plot" +"Multivariable regression model checks","Multivariable regression model checks" +"www/intro.html","www/intro.html" +"www/intro.md","www/intro.md" +"Get started","Get started" +"Choose your data","Choose your data" +"Upload a file, get data directly from REDCap or use local or sample data.","Upload a file, get data directly from REDCap or use local or sample data." +"Please be mindfull handling sensitive data","Please be mindfull handling sensitive data" +"

The FreesearchR app only stores data for analyses, but please only use with sensitive data when running locally. Read more here

","

The FreesearchR app only stores data for analyses, but please only use with sensitive data when running locally. Read more here

" +"Quick overview","Quick overview" +"Select variables for final import","Select variables for final import" +"Exclude incomplete variables:","Exclude incomplete variables:" +"At 0, only complete variables are included; at 100, all variables are included.","At 0, only complete variables are included; at 100, all variables are included." +"Manual selection:","Manual selection:" +"Let's begin!","Let's begin!" +"Prepare","Prepare" +"Overview and filter","Overview and filter" +"Overview and filtering","Overview and filtering" +"Below you find a summary table for quick insigths, and on the right you can visualise data classes, browse observations and apply different data filters.","Below you find a summary table for quick insigths, and on the right you can visualise data classes, browse observations and apply different data filters." +"Visual overview","Visual overview" +"Browse observations","Browse observations" +"Filter data types","Filter data types" +"Filter observations","Filter observations" +"Apply filter on observation","Apply filter on observation" +"Edit and create data","Edit and create data" +"Subset, rename and convert variables","Subset, rename and convert variables" +"Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.).","Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)." +"Please note that data modifications are applied before any filtering.","Please note that data modifications are applied before any filtering." +"Advanced data manipulation","Advanced data manipulation" +"Below options allow more advanced varaible manipulations.","Below options allow more advanced varaible manipulations." +"Reorder factor levels","Reorder factor levels" +"Reorder the levels of factor/categorical variables.","Reorder the levels of factor/categorical variables." +"New factor","New factor" +"Create factor/categorical variable from a continous variable (number/date/time).","Create factor/categorical variable from a continous variable (number/date/time)." +"New variable","New variable" +"Create a new variable based on an R-expression.","Create a new variable based on an R-expression." +"Compare modified data to original","Compare modified data to original" +"Raw print of the original vs the modified data.","Raw print of the original vs the modified data." +"Original data:","Original data:" +"Modified data:","Modified data:" +"Restore original data","Restore original data" +"Reset to original imported dataset. Careful! There is no un-doing.","Reset to original imported dataset. Careful! There is no un-doing." +"Evaluate","Evaluate" +"Characteristics","Characteristics" +"Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.","Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list." +"Compare strata?","Compare strata?" +"Option to perform statistical comparisons between strata in baseline table.","Option to perform statistical comparisons between strata in baseline table." +"Press 'Evaluate' to create the comparison table.","Press 'Evaluate' to create the comparison table." +"Correlations","Correlations" +"To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.","To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'." +"Correlation cut-off","Correlation cut-off" +"Set the cut-off for considered 'highly correlated'.","Set the cut-off for considered 'highly correlated'." +"Missings","Missings" +"To consider if data is missing by random, choose the outcome/dependent variable (only variables with any missings are available). If there is a significant difference across other variables depending on missing observations, it may not be missing at random.","To consider if data is missing by random, choose the outcome/dependent variable (only variables with any missings are available). If there is a significant difference across other variables depending on missing observations, it may not be missing at random." +"Visuals","Visuals" +"Analysis validation","Analysis validation" +"Report","Report" +"Choose your favourite output file format for further work, and download, when the analyses are done.","Choose your favourite output file format for further work, and download, when the analyses are done." +"Factor variable to reorder:","Factor variable to reorder:" +"Sort by levels","Sort by levels" +"Sort by count","Sort by count" +"Create a new variable (otherwise replaces the one selected)","Create a new variable (otherwise replaces the one selected)" +"Update factor variable","Update factor variable" +"Sort count","Sort count" +"Levels","Levels" +"Count","Count" +"Update levels of a factor","Update levels of a factor" +"Update & select variables","Update & select variables" +"Date format:","Date format:" +"Date to use as origin to convert date/datetime:","Date to use as origin to convert date/datetime:" +"Apply changes","Apply changes" +"No data to display.","No data to display." +"Data successfully updated!","Data successfully updated!" +"You removed {p_out} % of observations.","You removed {p_out} % of observations." +"You removed {p_out} % of variables.","You removed {p_out} % of variables." +"There is a total of {p_miss} % missing observations.","There is a total of {p_miss} % missing observations." +"There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}.","There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}." +"Data includes {n_pairs} pairs of highly correlated variables.","Data includes {n_pairs} pairs of highly correlated variables." +"Class","Class" +"Observations","Observations" +"File upload","File upload" +"REDCap server export","REDCap server export" +"Local or sample data","Local or sample data" +"Data is only stored for analyses and deleted when the app is closed.","Data is only stored for analyses and deleted when the app is closed." +"Consider [running ***FreesearchR*** locally](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine) if working with sensitive data.","Consider [running ***FreesearchR*** locally](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine) if working with sensitive data." +"Documentation","Documentation" +"Feedback","Feedback" +"License: AGPLv3","License: AGPLv3" +"Source","Source" +"Settings","Settings" +"The ***FreesearchR*** app only stores data for analyses, but please only use with sensitive data when running locally. [Read more here](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine).","The ***FreesearchR*** app only stores data for analyses, but please only use with sensitive data when running locally. [Read more here](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine)." +"Data classes and missing observations","Data classes and missing observations" +"We encountered the following error showing missingness:","We encountered the following error showing missingness:" +"Please confirm data reset!","Please confirm data reset!" +"Sure you want to reset data? This cannot be undone.","Sure you want to reset data? This cannot be undone." +"Confirm","Confirm" +"The filtered data","The filtered data" +"Create new factor","Create new factor" +"This window is aimed at advanced users and require some *R*-experience!","This window is aimed at advanced users and require some *R*-experience!" +"Create new variables","Create new variables" +"Select data types to include","Select data types to include" +"Uploaded data overview","Uploaded data overview" +"We encountered the following error browsing your data:","We encountered the following error browsing your data:" +"Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.","Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias." +"Data import","Data import" +"Data import formatting","Data import formatting" +"Data modifications","Data modifications" +"Variables filter","Variables filter" +"Data filter","Data filter" +"Data characteristics table","Data characteristics table" +"The dataset without text variables","The dataset without text variables" +"The data includes {n_col} variables. Please limit to 100.","The data includes {n_col} variables. Please limit to 100." +"Creating the table. Hold on for a moment..","Creating the table. Hold on for a moment.." +"Select variable to stratify analysis","Select variable to stratify analysis" +"Generating the report. Hold on for a moment..","Generating the report. Hold on for a moment.." +"We encountered the following error creating your report:","We encountered the following error creating your report:" +"There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Text or character to split string by","Text or character to split string by" +"Split the variable","Split the variable" +"Variable to split:","Variable to split:" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Split character string","Split character string" +"Split text","Split text" +"Split a character string by a common delimiter","Split a character string by a common delimiter" +"Select delimiter","Select delimiter" +"Browse data preview","Browse data preview" +"Original data","Original data" +"Preview of result","Preview of result" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." +"Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" diff --git a/app_docker/translations/translation_sw.csv b/app_docker/translations/translation_sw.csv index 6eade044..70d1fe1c 100644 --- a/app_docker/translations/translation_sw.csv +++ b/app_docker/translations/translation_sw.csv @@ -49,7 +49,6 @@ "Column added!","Column added!" "Unique values:","Unique values:" "Variable to cut:","Variable to cut:" -"Number of breaks:","Number of breaks:" "Close intervals on the right","Close intervals on the right" "Include lowest value","Include lowest value" "Create factor variable","Create factor variable" @@ -272,3 +271,23 @@ "By quantiles (groups of equal size)","By quantiles (groups of equal size)" "Please fill in web address and API token, then press 'Connect'.","Please fill in web address and API token, then press 'Connect'." "There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from an existing variable or new variables with R code. At the bottom you can restore the original data." +"Text or character to split string by","Text or character to split string by" +"Split the variable","Split the variable" +"Variable to split:","Variable to split:" +"Direction:","Direction:" +"Split string to multiple columns. Keep number of rows.","Split string to multiple columns. Keep number of rows." +"Split string to multiple observations (rows) in the same column. Also ads id and instance columns","Split string to multiple observations (rows) in the same column. Also ads id and instance columns" +"Split character string","Split character string" +"Split text","Split text" +"Split a character string by a common delimiter","Split a character string by a common delimiter" +"Select delimiter","Select delimiter" +"Browse data preview","Browse data preview" +"Original data","Original data" +"Preview of result","Preview of result" +"No character variables with accepted delimiters detected.","No character variables with accepted delimiters detected." +"Split a text column by a recognised delimiter.","Split a text column by a recognised delimiter." +"Apply split","Apply split" +"Stacked relative barplot","Stacked relative barplot" +"Create relative stacked barplots to show the distribution of categorical levels","Create relative stacked barplots to show the distribution of categorical levels" +"Side-by-side barplot","Side-by-side barplot" +"Create side-by-side barplot to show the distribution of categorical levels","Create side-by-side barplot to show the distribution of categorical levels" diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index b8f7ea8f..5ffb389a 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//Rtmp5UwPqh/filef21e56757ae4.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpigVRui/file787d74b713ef.R ######## i18n_path <- system.file("translations", package = "FreesearchR") @@ -62,7 +62,7 @@ i18n$set_translation_language("en") #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'25.10.4' +app_version <- function()'25.10.5' ######## @@ -424,35 +424,6 @@ create_column_ui <- function(id) { 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() - # tags$style(HTML(" - # /* modified from esquisse for data types */ - # .btn-column-categorical { - # background-color: #EF562D; - # color: #FFFFFF; - # } - # .btn-column-continuous { - # background-color: #0C4C8A; - # color: #FFFFFF; - # } - # .btn-column-dichotomous { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-datetime { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-id { - # background-color: #848484; - # color: #FFFFFF; - # } - # .btn-column-text { - # background-color: #2E2E2E; - # color: #FFFFFF; - # }")) - # ), fluidRow( column( width = 6, @@ -1216,9 +1187,16 @@ cut_var.factor <- function(x, breaks = NULL, type = c("top", "bottom"), other = tbl <- sort(table(x), decreasing = TRUE) if (type == "top") { + if (length(levels(x)) <= breaks){ + return(x) + } lvls <- names(tbl[seq_len(breaks)]) } else if (type == "bottom") { - lvls <- names(tbl)[!tbl / NROW(x) * 100 < breaks] + freqs_check <- tbl / NROW(x) * 100 < breaks + if (!any(freqs_check)){ + return(x) + } + lvls <- names(tbl)[!freqs_check] } if (other %in% lvls) { @@ -1312,14 +1290,7 @@ cut_variable_ui <- function(id) { ), column( width = 3, - numericInput( - inputId = ns("n_breaks"), - label = i18n$t("Number of breaks:"), - value = 3, - min = 2, - max = 12, - width = "100%" - ) + shiny::uiOutput(ns("n_breaks")) ), column( width = 3, @@ -1400,8 +1371,38 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # ) }), data_r(), input$hidden) + output$n_breaks <- shiny::renderUI({ + req(input$method) + # req(!is.null(get_list_elements(name = input$cut_method,element = "breaks"))) + # browser() + + break_text <- get_list_elements(name = input$method, element = "breaks") + + if (is.null(get_list_elements(name = input$method, element = "min"))) { + min <- 2 + } else { + min <- get_list_elements(name = input$method, element = "min") + } + + if (is.null(get_list_elements(name = input$method, element = "max"))) { + max <- 10 + } else { + max <- get_list_elements(name = input$method, element = "max") + } + + numericInput( + inputId = ns("n_breaks"), + label = break_text, + value = 3, + min = min, + max = max, + width = "100%" + ) + }) + output$slider_fixed <- renderUI({ data <- req(data_r()) + req(input$n_breaks) variable <- req(input$variable) req(hasName(data, variable)) @@ -1491,13 +1492,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { choices <- unique(choices) - ## Implement labeled vector selection of cut methods to include descriptions - ## - ## cut_methods() - ## - - - vectorSelectInput( inputId = ns("method"), label = i18n$t("Method:"), @@ -1505,14 +1499,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { selected = NULL, width = "100%" ) - - # shinyWidgets::virtualSelectInput( - # inputId = session$ns("method"), - # label = i18n$t("Method:"), - # choices = choices, - # selected = NULL, - # width = "100%" - # ) }) @@ -1665,6 +1651,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) + count_data <- as.data.frame( table( breaks = data[[length(data)]], @@ -1672,6 +1659,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ), responseName = "count" ) + count_data$freq <- paste(signif(count_data$count / nrow(data) * 100, 3), "%") + # browser() gridTheme <- getOption("datagrid.theme") if (length(gridTheme) < 1) { datamods:::apply_grid_theme() @@ -1679,7 +1668,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { on.exit(toastui::reset_grid_theme()) grid <- toastui::datagrid( data = count_data, - colwidths = "guess", + colwidths = "fit", theme = "default", bodyHeight = "auto" ) @@ -1767,55 +1756,63 @@ cut_methods <- function() { "hour" = list( descr = i18n$t("Hour of the day"), # class = c("hms", "POSIXct"), # Not implemented yet, but will during rewrite at some point... - breaks = i18n$t("Breaks") + breaks = NULL ), "day" = list( descr = i18n$t("By day of the week"), - breaks = i18n$t("Breaks") + breaks = NULL ), "weekday" = list( descr = i18n$t("By weekday"), - breaks = i18n$t("Breaks") + breaks = NULL ), "week" = list( descr = i18n$t("By week number and year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "week_only" = list( descr = i18n$t("By week number"), - breaks = i18n$t("Breaks") + breaks = NULL ), "month" = list( descr = i18n$t("By month and year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "month_only" = list( descr = i18n$t("By month only"), - breaks = i18n$t("Breaks") + breaks = NULL ), "quarter" = list( descr = i18n$t("By quarter of the year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "year" = list( descr = i18n$t("By year"), - breaks = i18n$t("Breaks") + breaks = NULL ), "top" = list( descr = i18n$t("Keep only most common"), - breaks = i18n$t("Number") + breaks = i18n$t("Number"), + min = 1, + max = 20 ), "bottom" = list( descr = i18n$t("Combine below percentage"), - breaks = i18n$t("Percentage") + breaks = i18n$t("Percentage"), + min = 1, + max = 50 ), "fixed" = list( descr = i18n$t("By specified numbers"), - breaks = i18n$t("Breaks") + breaks = i18n$t("Breaks"), + min = 2, + max = 12 ), "quantile" = list( descr = i18n$t("By quantiles (groups of equal size)"), - breaks = i18n$t("Breaks") + breaks = i18n$t("Breaks"), + min = 2, + max = 10 ) ) } @@ -1836,9 +1833,13 @@ cut_methods <- function() { #' @examples #' get_list_elements(c("top", "bottom"), "descr") get_list_elements <- function(name, element, dict = cut_methods()) { - sapply(dict[name], \(.x){ - .x[[element]] - }) + if (is.null(name)) { + return(NULL) + } else { + sapply(dict[name], \(.x){ + .x[[element]] + }) + } } #' Set values as names and names as values @@ -2204,6 +2205,12 @@ data_visuals_server <- function(id, ter = input$tertiary ) + ## If the dictionary holds additional arguments to pass to the + ## plotting function, these are included + if (!is.null(rv$plot.params()[["fun.args"]])){ + parameters <- modifyList(parameters,rv$plot.params()[["fun.args"]]) + } + shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."), { rv$plot <- rlang::exec( create_plot, @@ -2353,6 +2360,28 @@ subset_types <- function(data, types, type.fun = data_type) { #' supported_plots() |> str() supported_plots <- function() { list( + plot_bar_rel = list( + fun = "plot_bar", + fun.args =list(style="fill"), + descr = i18n$t("Stacked relative barplot"), + note = i18n$t("Create relative stacked barplots to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = NULL + ), + plot_bar_abs = list( + fun = "plot_bar", + fun.args =list(style="dodge"), + descr = i18n$t("Side-by-side barplot"), + note = i18n$t("Create side-by-side barplot to show the distribution of categorical levels"), + primary.type = c("dichotomous", "categorical"), + secondary.type = c("dichotomous", "categorical"), + secondary.multi = FALSE, + tertiary.type = c("dichotomous", "categorical"), + secondary.extra = "none" + ), plot_hbars = list( fun = "plot_hbars", descr = i18n$t("Stacked horizontal bars"), @@ -2367,7 +2396,7 @@ supported_plots <- function() { fun = "plot_violin", descr = i18n$t("Violin plot"), note = i18n$t("A modern alternative to the classic boxplot to visualise data distribution"), - primary.type = c("datatime", "continuous", "dichotomous", "categorical"), + primary.type = c("datatime", "continuous"), secondary.type = c("dichotomous", "categorical"), secondary.multi = FALSE, secondary.extra = "none", @@ -2405,7 +2434,7 @@ supported_plots <- function() { fun = "plot_box", descr = i18n$t("Box plot"), note = i18n$t("A classic way to plot data distribution by groups"), - primary.type = c("datatime", "continuous", "dichotomous", "categorical"), + primary.type = c("datatime", "continuous"), secondary.type = c("dichotomous", "categorical"), secondary.multi = FALSE, tertiary.type = c("dichotomous", "categorical"), @@ -4245,7 +4274,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.10.4-251027' +hosted_version <- function()'v25.10.5-251031' ######## @@ -5360,6 +5389,7 @@ data_missings_ui <- function(id) { data_missings_server <- function(id, data, variable, + max_level=20, ...) { shiny::moduleServer( id = id, @@ -5380,7 +5410,7 @@ data_missings_server <- function(id, tryCatch( { - out <- compare_missings(df_tbl,by_var) + out <- compare_missings(df_tbl,by_var,max_level = max_level) }, error = function(err) { showNotification(paste0("Error: ", err), type = "err") @@ -5469,8 +5499,18 @@ missing_demo_app() #' @returns gtsummary list object #' @export #' -compare_missings <- function(data,by_var){ +compare_missings <- function(data,by_var,max_level=20){ if (!is.null(by_var) && by_var != "" && by_var %in% names(data)) { + data <- data |> + lapply(\(.x){ + # browser() + if (is.factor(.x)){ + cut_var(.x,breaks=20,type="top") + } else { + .x + } + }) |> dplyr::bind_cols() + data[[by_var]] <- ifelse(is.na(data[[by_var]]), "Missing", "Non-missing") out <- gtsummary::tbl_summary(data, by = by_var) |> @@ -5482,6 +5522,137 @@ compare_missings <- function(data,by_var){ } +######## +#### Current file: /Users/au301842/FreesearchR/R//plot_bar.R +######## + +plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"), max_level = 30, ...) { + style <- match.arg(style) + + if (!is.null(ter)) { + ds <- split(data, data[ter]) + } else { + ds <- list(data) + } + + out <- lapply(ds, \(.ds){ + plot_bar_single( + data = .ds, + pri = pri, + sec = sec, + style = style, + max_level = max_level + ) + }) + + wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...) +} + + +#' Single vertical barplot +#' +#' @param style barplot style passed to geom_bar position argument. +#' One of c("stack", "dodge", "fill") +#' +#' @name data-plots +#' +#' @returns ggplot object +#' @export +#' +#' @examples +#' mtcars |> +#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> +#' plot_bar_single(pri = "cyl", sec = "am", style = "fill") +#' +#' mtcars |> +#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> +#' plot_bar_single(pri = "cyl", style = "stack") +plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30) { + style <- match.arg(style) + + if (identical(sec, "none")) { + sec <- NULL + } + + p_data <- as.data.frame(table(data[c(pri, sec)])) |> + dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor), + p = Freq / NROW(data) + ) + + + if (nrow(p_data) > max_level) { + # browser() + p_data <- sort_by( + p_data, + p_data[["Freq"]], + decreasing = TRUE + ) |> + head(max_level) + # if (is.null(sec)){ + # p_data <- sort_by( + # p_data, + # p_data[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # } else { + # split(p_data,p_data[[sec]]) |> + # lapply(\(.x){ + # # browser() + # sort_by( + # .x, + # .x[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # }) |> dplyr::bind_rows() + # } + } + + ## Shortens long level names + p_data[[pri]] <- forcats::as_factor(unique_short(as.character(p_data[[pri]]), max = 20)) + + if (!is.null(sec)) { + fill <- sec + } else { + fill <- pri + } + + p <- ggplot2::ggplot( + p_data, + ggplot2::aes( + x = .data[[pri]], + y = p, + fill = .data[[fill]] + ) + ) + + ggplot2::geom_bar(position = style, stat = "identity") + + ggplot2::scale_y_continuous(labels = scales::percent) + + ggplot2::ylab("Percentage") + + ggplot2::xlab(get_label(data,pri))+ + ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data,fill))) + + ## To handle large number of levels and long level names + + if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) { + p <- p + + # ggplot2::guides(fill = "none") + + ggplot2::theme( + axis.text.x = ggplot2::element_text( + angle = 90, + vjust = 1, hjust = 1 + ))+ + ggplot2::theme( + axis.text.x = ggplot2::element_text(vjust = 0.5) + ) + + if (is.null(sec)){ + p <- p + + ggplot2::guides(fill = "none") + } + } + p +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//plot_box.R ######## @@ -5527,8 +5698,6 @@ plot_box <- function(data, pri, sec, ter = NULL,...) { } - - #' Create nice box-plots #' #' @name data-plots @@ -8744,6 +8913,462 @@ modify_qmd <- function(file, format) { +######## +#### Current file: /Users/au301842/FreesearchR/R//separate_string.R +######## + +#' String split module based on tidyr::separate_ +#' +#' @param id id +#' +#' @returns A shiny ui module +#' @export +#' +#' @name split-string +#' +string_split_ui <- function(id) { + ns <- NS(id) + tagList( + shiny::fluidRow( + # shiny::textOutput(outputId = ns("no_splits")), + column( + width = 4, + shiny::uiOutput(outputId = ns("variable")) + ), + column( + width = 4, + shiny::uiOutput(outputId = ns("delim")) + ), + column( + width = 4, + shiny::uiOutput(outputId = ns("direction")) + ) # , + # column( + # width = 3, + # actionButton( + # inputId = ns("split"), + # label = tagList(phosphoricons::ph("scissors"), i18n$t("Split the variable")), + # class = "btn-outline-primary float-end" + # ) + # ) + ), + shiny::fluidRow( + column( + width = 4, + shiny::h4(i18n$t("Original data")), + toastui::datagridOutput2(outputId = ns("orig_data")) + # DT::DTOutput(outputId = ns("orig_data_3")) + # This doesn't render... + # toastui::datagridOutput2(outputId = ns("orig_data_2")) + ), + column( + width = 8, + shiny::h4(i18n$t("Preview of result")), + toastui::datagridOutput2(outputId = ns("new_data")) + ) + ), + actionButton( + inputId = ns("create"), + label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")), + class = "btn-outline-primary float-end" + ), + tags$div(class = "clearfix") + ) +} + + + +#' @param data_r reactive data +#' +#' @returns shiny module server +#' @export +#' +#' @name split-string +#' +string_split_server <- function(id, data_r = reactive(NULL)) { + moduleServer( + id, + function(input, output, session) { + rv <- reactiveValues(data = NULL, target=NULL, temp = NULL, out=NULL) + + ns <- session$ns + + # output$no_splits <- shiny::renderText({ + # req({ + # data_r() + # }) + # + # if (any(is_splittable(data_r()))) { + # i18n$t("No character variables with accepted delimiters detected.") + # } + # }) + + shiny::observe({ + req(data_r()) + + # if (any(is_splittable(data_r()))) { + data <- data_r() + rv$data <- data + + vars_num <- vapply(data, \(.x){ + is_splittable(.x) + }, logical(1)) + vars_num <- names(vars_num)[vars_num] + + req(length(vars_num)>0) + + output$variable <- shiny::renderUI( + columnSelectInput( + inputId = ns("variable"), + data = data, + label = i18n$t("Variable to split:"), + width = "100%", + col_subset = vars_num, + selected = if (isTruthy(input$variable)) input$variable else vars_num[1] + ) + ) + # } + # shinyWidgets::updateVirtualSelect( + # inputId = "variable", + # choices = vars_num, + # selected = if (isTruthy(input$variable)) input$variable else vars_num[1] + # ) + }) + + output$delim <- shiny::renderUI({ + req(rv$data) + req(input$variable) + # browser() + + req(input$variable %in% names(rv$data)) + # req({ + # any(apply(data_r(),2,is_splittable)) + # }) + # if (any(is_splittable(data_r()))) { + data <- rv$data |> + dplyr::select(tidyselect::all_of(input$variable)) + + delimiters <- Reduce(c, unique(sapply(data[[1]], detect_delimiter))) + + # shiny::textInput(inputId = ns("delim"), label = i18n$t("Text or character to split string by")) + shiny::selectInput( + inputId = ns("delim"), label = i18n$t("Select delimiter"), + choices = setNames( + delimiters, + glue::glue("'{delimiters}'") + ), selected = 1 + ) + # } + }) + + + output$direction <- shiny::renderUI({ + # req({ + # rv$data + # }) + + # if (any(is_splittable(data_r()))) { + vectorSelectInput( + inputId = ns("direction"), + label = i18n$t("Direction:"), + choices = setNames( + c( + "wide", + "long" + ), + c( + i18n$t("Split string to multiple columns. Keep number of rows."), + i18n$t("Split string to multiple observations (rows) in the same column. Also ads id and instance columns") + ) + ), + selected = "wide", + width = "100%" + ) + # } + }) + + observeEvent( + list( + input$variable, + input$delim, + input$direction + ), + { + req(rv$data) + req(input$variable) + req(input$delim) + req(input$direction) + + data <- rv$data |> + dplyr::select(tidyselect::all_of(input$variable)) + # browser() + rv$temp <- separate_string( + data = data, + col = input$variable, + delim = input$delim, + direction = input$direction + ) + } + ) + + # shiny::observeEvent(input$split, { + # show_data(rv$temp, title = i18n$t("Browse data preview"), type = "modal") + # }) + + ## Toastui would not render the original data, so the solution was to go + ## with native table rendering, which works, but doesn't please the eye + + # output$orig_data <- shiny::renderTable({ + # req(data_r()) + # req(input$variable) + # data <- data_r() |> + # dplyr::select(tidyselect::all_of(input$variable)) + # # browser() + # head(data, 10) + # }) + + output$orig_data <- toastui::renderDatagrid2({ + req(data_r()) + req(input$variable) + + req(hasName(rv$data, input$variable)) + + data <- data_r() |> + dplyr::select(tidyselect::all_of(input$variable)) |> + head(30) |> + dplyr::mutate(row=dplyr::row_number()) |> + dplyr::select(row,tidyselect::everything()) + # browser() + toastui::datagrid( + data = data, + rowHeight = 40, + colwidths = "guess", + theme = "default", + bodyHeight = "auto", + pagination = 10) + }) + + output$new_data <- toastui::renderDatagrid2({ + shiny::req(rv$temp) + data <- rv$temp + toastui::datagrid( + data = head(data, 30), + rowHeight = 40, + colwidths = "guess", + theme = "default", + bodyHeight = "auto", pagination = 10 + ) + }) + + data_split_r <- reactive({ + req(rv$temp) + + data <- rv$data + + parameters <- list( + col = input$variable, + delim = input$delim, + direction = input$direction + ) + + out <- tryCatch({ + rlang::exec(separate_string, !!!modifyList( + parameters, + list( + data = data + ) + )) + }) + # browser() + + # separate_string( + # data = data, + # + # ) + + code <- rlang::call2( + "separate_string", + !!!parameters, + .ns = "FreesearchR" + ) + attr(out, "code") <- code + out}) + + data_returned_r <- observeEvent(input$create, { + rv$out <- data_split_r() + }) + + return(reactive(rv$out)) + } + ) +} + + +#' @param title Modal title +#' @param easyClose easyClose +#' @param size size +#' @param footer footer +#' +#' @returns shiny modal +#' @export +#' +#' @name split-string +modal_string_split <- function(id, + title = i18n$t("Split character string"), + easyClose = TRUE, + size = "xl", + footer = NULL) { + ns <- NS(id) + showModal(modalDialog( + title = tagList(title, datamods:::button_close_modal()), + string_split_ui(id), + tags$div( + style = "display: none;", + textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) + ), + easyClose = easyClose, + size = size, + footer = footer + )) +} + + +### Helpers + +#' Separate string wide or long +#' +#' @param data data +#' @param col column +#' @param delim delimiter +#' @param direction target direction +#' +#' @returns data.frame +#' @export +#' +separate_string <- function(data, col, delim, direction = c("wide", "long")) { + direction <- match.arg(direction) + + if (direction == "long") { + out <- data |> + dplyr::mutate(id_str_split = dplyr::row_number()) |> + dplyr::group_by_at("id_str_split") |> + tidyr::separate_longer_delim(cols = tidyselect::all_of(col), delim = delim) |> + dplyr::mutate(instance_str_split = dplyr::row_number()) |> + # add_instance(by="id") + dplyr::ungroup() |> + dplyr::mutate(dplyr::across(tidyselect::matches(col), trimws)) + } else if (direction == "wide") { + ## Experiment of wide to long + + out <- data |> + tidyr::separate_wider_delim( + cols = tidyselect::all_of(col), + delim = delim, + names_sep = "_", + too_few = "align_start" + ) |> + dplyr::mutate(dplyr::across(tidyselect::starts_with(col), trimws)) + } + + out +} + + + +#' Detect delimiters in string based on allowed delimiters +#' +#' @description +#' Accepts any repeat of delimiters and includes surrounding whitespace +#' +#' +#' @param text character vector +#' @param delimiters allowed delimiters +#' +#' @returns character vector +#' @export +#' +#' @examples +#' sapply(c("Walk - run", "Sel__Re", "what;now"), detect_delimiter) +detect_delimiter <- function(data, delimiters = c("_", "-", ";", "\n", ",")) { + # Create patterns for each delimiter with potential surrounding whitespace + patterns <- paste0("\\s*\\", delimiters, "+\\s*") + + # Check each pattern + out <- sapply(patterns, \(.x){ + if (grepl(.x, data)) { + # Extract the actual matched delimiter with whitespace + regmatches(data, regexpr(.x, data)) + } + }) + + Reduce(c, out) +} + + +#' Determine if any variable in data frame character and contains recognized delimiters +#' +#' @param data vector or data.frame +#' +#' @returns logical +#' @export +#' +#' @examples +#' any(apply(mtcars, 2, is_splittable)) +#' is_splittable(mtcars) +is_splittable <- function(data) { + if (is.data.frame(data)) { + return(apply(data, 2, is_splittable)) + } + + if (is.character(data)) { + if (length(Reduce(c, unique(sapply(data, detect_delimiter)))) > 0) { + TRUE + } else { + FALSE + } + } else { + FALSE + } +} + +# mtcars |> simple_dt() +simple_dt <- function(data,...){ + headerCallbackRemoveHeaderFooter <- c( + "function(thead, data, start, end, display){", + " $('th', thead).css('display', 'none');", + "}" + ) + + DT::datatable( + data, + options = list( + dom = "t", + ordering = FALSE, + paging = FALSE, + searching = FALSE, + # headerCallback = DT::JS(headerCallbackRemoveHeaderFooter), + columnDefs = list( + list( + targets = 1, + render = DT::JS( + "function(data, type, row, meta) {", + "return type === 'display' && data.length > 10 ?", + "'' + data.substr(0, 10) + '...' : data;", + "}"))) + ), + selection = 'none', + callback = DT::JS( + "$('table.dataTable.no-footer').css('border-bottom', 'none');" + ), + class = 'row-border', + escape = FALSE, + rownames = FALSE, + # width = 500, + filter = "none" + ) +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//syntax_highlight.R ######## @@ -9013,7 +9638,7 @@ ui_elements <- function(selection) { import_globalenv_ui( id = "env", title = NULL, - packages = c("NHANES", "stRoke", "datasets") + packages = c("NHANES", "stRoke", "datasets", "MASS") ) ), # shiny::conditionalPanel( @@ -9182,7 +9807,7 @@ ui_elements <- function(selection) { shiny::tags$br(), shiny::fluidRow( shiny::column( - width = 4, + width = 3, shiny::actionButton( inputId = "modal_update", label = i18n$t("Reorder factor levels"), @@ -9194,7 +9819,7 @@ ui_elements <- function(selection) { shiny::tags$br() ), shiny::column( - width = 4, + width = 3, shiny::actionButton( inputId = "modal_cut", label = i18n$t("New factor"), @@ -9206,7 +9831,19 @@ ui_elements <- function(selection) { shiny::tags$br() ), shiny::column( - width = 4, + width = 3, + shiny::actionButton( + inputId = "modal_string", + label = i18n$t("Split text"), + width = "100%" + ), + shiny::tags$br(), + shiny::helpText(i18n$t("Split a text column by a recognised delimiter.")), + shiny::tags$br(), + shiny::tags$br() + ), + shiny::column( + width = 3, shiny::actionButton( inputId = "modal_column", label = i18n$t("New variable"), @@ -12031,7 +12668,7 @@ server <- function(input, output, session) { }) ## Activating action buttons on data imported - shiny::observeEvent(rv$data_original, { + shiny::observeEvent(list(rv$data_original, rv$data), { if (is.null(rv$data_original) | NROW(rv$data_original) == 0) { shiny::updateActionButton(inputId = "act_start", disabled = TRUE) shiny::updateActionButton(inputId = "modal_browse", disabled = TRUE) @@ -12051,6 +12688,16 @@ server <- function(input, output, session) { } }) + shiny::observeEvent(list(rv$data_original, rv$data), { + if (is.null(rv$data_original) | NROW(rv$data_original) == 0 | is.null(rv$data) | !any(is_splittable(rv$data))) { + shiny::updateActionButton(inputId = "modal_string", disabled = TRUE) + } else if (!is.null(rv$data) && any(is_splittable(rv$data))) { + shiny::updateActionButton(inputId = "modal_string", disabled = FALSE) + } + }) + + + ############################################################################## ######### ######### Data modification section @@ -12142,6 +12789,29 @@ server <- function(input, output, session) { rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") }) + ######### Split string + + shiny::observeEvent( + input$modal_string, + modal_string_split( + id = "modal_string", + title = i18n$t("Split a character string by a common delimiter") + ) + ) + + data_modal_string <- string_split_server( + id = "modal_string", + data_r = reactive(rv$data) + ) + + shiny::observeEvent( + data_modal_string(), + { + rv$data <- data_modal_string() + rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") + } + ) + ######### Create column shiny::observeEvent( @@ -12579,6 +13249,16 @@ server <- function(input, output, session) { add.overall = TRUE ) + ## Limits maximum number of levels included in baseline table to 20. + data <- rv$list$data |> + lapply(\(.x){ + # browser() + if (is.factor(.x)){ + cut_var(.x,breaks=20,type="top") + } else { + .x + } + }) |> dplyr::bind_cols() # Attempt to introduce error on analysing too large dataset # tryCatch( @@ -12589,7 +13269,7 @@ server <- function(input, output, session) { # print("Please limit to 100.") # } else { shiny::withProgress(message = i18n$t("Creating the table. Hold on for a moment.."), { - rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data, parameters, "data")) + rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(data, parameters, "data")) }) # } # },