diff --git a/CITATION.cff b/CITATION.cff index 41ce08b6..fcab7f68 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.12.1 +version: 25.11.1 doi: 10.5281/zenodo.14527429 identifiers: - type: url @@ -1063,40 +1063,6 @@ references: orcid: https://orcid.org/0000-0002-7559-1154 year: '2025' doi: 10.32614/CRAN.package.stRoke -- type: software - title: data.table - abstract: 'data.table: Extension of `data.frame`' - notes: Imports - url: https://r-datatable.com - repository: https://CRAN.R-project.org/package=data.table - authors: - - family-names: Barrett - given-names: Tyson - email: t.barrett88@gmail.com - orcid: https://orcid.org/0000-0002-2137-1391 - - family-names: Dowle - given-names: Matt - email: mattjdowle@gmail.com - - family-names: Srinivasan - given-names: Arun - email: asrini@pm.me - - family-names: Gorecki - given-names: Jan - - family-names: Chirico - given-names: Michael - orcid: https://orcid.org/0000-0003-0787-087X - - family-names: Hocking - given-names: Toby - orcid: https://orcid.org/0000-0002-3146-0865 - - family-names: Schwendinger - given-names: Benjamin - orcid: https://orcid.org/0000-0003-3315-8114 - - family-names: Krylov - given-names: Ivan - email: ikrylov@disroot.org - orcid: https://orcid.org/0000-0002-0172-3812 - year: '2025' - doi: 10.32614/CRAN.package.data.table - type: software title: styler abstract: 'styler: Non-Invasive Pretty Printing of R Code' diff --git a/DESCRIPTION b/DESCRIPTION index 035421e6..7301de4b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: Easy data analysis for clinicians -Version: 25.12.1 +Version: 25.11.2 Authors@R: c( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), diff --git a/NAMESPACE b/NAMESPACE index 1365c2d0..127b112c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,7 +51,6 @@ export(default_parsing) export(detect_delimiter) export(drop_empty_event) export(expression_string) -export(factor_new_levels_labels) export(factorize) export(file_export) export(format_writer) @@ -149,7 +148,6 @@ export(symmetrical_scale_x_log10) export(tbl_merge) export(type_icons) export(ui_elements) -export(unique_names) export(unique_short) export(update_factor_server) export(update_factor_ui) diff --git a/NEWS.md b/NEWS.md index 9e59a927..6a4a4600 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,3 @@ -# FreesearchR 25.12.1 - -*NEW* Option to edit factor label names in the "New factor" pop-up. This allows for easier naming for tables, but also to combine levels. A new variable is appended to the dataset if label names are changed. Code is now also exported. - -*FIX* Fixes a bug, where white space in code exported was removed. Now a little too many spaces are included. Fine tuning continues. - -*NEW* Easily copy code by just clicking "copy" in code blocks. - # FreesearchR 25.11.2 *NEW* Vignettes were moved to the [FreesearchR project knowledge base](https://freesearchr.github.io/FreesearchR-knowledge/). This was mainly to ease rendering and allow quick and easy updates as well as future translations. diff --git a/R/app_version.R b/R/app_version.R index c86ba1bf..54c6cdf0 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.12.1' +app_version <- function()'25.11.2' diff --git a/R/cut-variable-ext.R b/R/cut-variable-ext.R index cb27543c..c1879b7c 100644 --- a/R/cut-variable-ext.R +++ b/R/cut-variable-ext.R @@ -374,11 +374,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } ) - data <- append_column(data, - column = new_variable, - name = unique_names(paste0(variable, "_cut"), - existing = names(data)), - index = "right") + data <- append_column(data, column = new_variable, name = paste0(variable, "_cut"), index = "right") code <- rlang::call2( "append_column", diff --git a/R/helpers.R b/R/helpers.R index 635f6799..c038c5c1 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -515,82 +515,18 @@ pipe_string <- function(data, collapse = "|>\n") { #' @examples #' list( #' as.symbol(paste0("mtcars$", "mpg")), -#' rlang::call2(.fn = "select", !!!list(c("cyl", "di sp")), .ns = "dplyr"), +#' rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"), #' rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") #' ) |> #' merge_expression() |> #' expression_string() expression_string <- function(data, assign.str = "") { exp.str <- if (is.call(data)) deparse(data) else data - + # browser() out <- paste0(assign.str, gsub("%>%", "|>\n", paste(gsub('"', "'", paste(exp.str, collapse = "")), collapse = ""))) - out <- collapse_spaces(out,preserve_newlines = FALSE) - gsub("`", "", out) + gsub(" |`", "", out) } -#' Substitue spaces/tabs with single space excluding text within quotes -#' -#' @description -#' Written assisted by Claude.ai. It is long and possibly too complicated, -#' but it works -#' -#' -#' @param x character string -#' @param preserve_newlines flag to preserve new lines -#' -#' @returns character string -#' -#' @examples -#' collapse_spaces(c("cyl", "di sp","s e d","d e'dl e'")) -collapse_spaces <- function(x, preserve_newlines = TRUE) { - # Function to process a single string - process_string <- function(text) { - # Pattern to match single-quoted strings - quote_pattern <- "'[^']*'" - - # Find all quoted strings and their positions - quotes <- gregexpr(quote_pattern, text, perl = TRUE)[[1]] - - if (quotes[1] == -1) { - # No quoted strings, process entire text - if (preserve_newlines) { - return(gsub("[ \\t]{1,}", " ", text)) - } else { - return(gsub("\\s{1,}", " ", text)) - } - } - - # Extract quoted strings - quote_lengths <- attr(quotes, "match.length") - quoted_parts <- substring(text, quotes, quotes + quote_lengths - 1) - - # Create placeholders - placeholders <- paste0("__QUOTE_", seq_along(quoted_parts), "__") - - # Replace quoted strings with placeholders - result <- text - for (i in seq_along(quoted_parts)) { - result <- sub(quote_pattern, placeholders[i], result, perl = TRUE) - } - - # Collapse spaces in non-quoted parts - if (preserve_newlines) { - result <- gsub("[ \\t]{2,}", "", result) - } else { - result <- gsub("\\s{2,}", "", result) - } - - # Restore quoted strings - for (i in seq_along(quoted_parts)) { - result <- sub(placeholders[i], quoted_parts[i], result, fixed = TRUE) - } - - return(result) - } - - # Apply to each element of vector - sapply(x, process_string, USE.NAMES = FALSE) -} #' Very simple function to remove nested lists, like when uploading .rds #' diff --git a/R/hosted_version.R b/R/hosted_version.R index 920e146f..b477b7ff 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.12.1-251202' +hosted_version <- function()'v25.11.2-251119' diff --git a/R/syntax_highlight.R b/R/syntax_highlight.R index 29ae8a82..e90f14b1 100644 --- a/R/syntax_highlight.R +++ b/R/syntax_highlight.R @@ -11,25 +11,15 @@ prismCodeBlock <- function(code) { prismDependencies <- tags$head( tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/prism.min.js"), - tags$link( - rel = "stylesheet", type = "text/css", - href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css" - ), - tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js"), - tags$link( - rel = "stylesheet", - href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.css" - ), - tags$script( - src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.js" - ), - tags$script( - src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/copy-to-clipboard/prism-copy-to-clipboard.min.js" - ) + tags$link(rel = "stylesheet", type = "text/css", + href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css") ) +prismRDependency <- tags$head( + tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js") +) -html_code_wrap <- function(string, lang = "r") { +html_code_wrap <- function(string,lang="r"){ glue::glue("
{string}
   
") } diff --git a/R/sysdata.rda b/R/sysdata.rda index d5263737..d644c198 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R index a895350f..7c1236e0 100644 --- a/R/update-factor-ext.R +++ b/R/update-factor-ext.R @@ -1,3 +1,4 @@ + ## Works, but not implemented ## ## These edits mainly allows for @@ -100,6 +101,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { moduleServer( id, function(input, output, session) { + rv <- reactiveValues(data = NULL, data_grid = NULL) bindEvent(observe({ @@ -205,37 +207,19 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) grid <- req(input$grid_data) - - parameters <- list( - variable = variable, - new_variable = isTRUE(input$new_var) | any(grid[["Var1_toset"]] == "New label"), - new_levels = as.character(grid[["Var1"]]), - new_labels = as.character(grid[["Var1_toset"]]), - ignore = "New label" + name_var <- if (isTRUE(input$new_var)) { + paste0(variable, "_updated") + } else { + variable + } + data[[name_var]] <- factor( + as.character(data[[variable]]), + levels = grid[["Var1"]] ) - - data <- tryCatch( - { - rlang::exec( - factor_new_levels_labels, - !!!modifyList(parameters, - val = list(data = data) - ) - ) - }, - error = function(err) { - showNotification(paste("We encountered the following error creating the new factor:", err), type = "err") - } + data[[name_var]] <- factor( + data[[variable]], + labels = ifelse(grid[["Var1_toset"]]=="New label",grid[["Var1"]],grid[["Var1_toset"]]) ) - - # browser() - code <- rlang::call2( - "factor_new_levels_labels", - !!!parameters, - .ns = "FreesearchR" - ) - attr(data, "code") <- code - data }) @@ -247,62 +231,6 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { ) } -#' Simple function to apply new levels and/or labels to factor -#' -#' @param variable factor variable -#' @param new_level new levels, same length as original -#' @param new_label new labels, same length as original -#' @param ignore character string to ignore in new labels -#' -#' @returns factor -#' @export -#' -#' @examples -#' data_n <- mtcars -#' data_n$cyl <- factor(data_n$cyl) -#' factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label")) -factor_new_levels_labels <- function( - data, - variable, - new_variable = TRUE, - new_levels = NULL, - new_labels = NULL, - ignore = "New label") { - if (!is.factor(data[[variable]])) { - return(data) - } - - if (is.null(new_levels)) { - new_levels <- levels(data[[variable]]) - } - - if (is.null(new_labels)) { - new_labels <- labels(data[[variable]]) - } - - with_level <- factor( - as.character(data[[variable]]), - levels = new_levels - ) - with_label <- factor( - with_level, - labels = ifelse(new_labels == "New label", new_levels, new_labels) - ) - - # browser() - - if (isTRUE(new_variable)) { - append_column( - data = data, - column = with_label, - name = unique_names(new = paste0(variable, "_updated"), existing = names(data)) - ) - } else { - data[[variable]] <- new_variable - data - } -} - #' @inheritParams shiny::modalDialog @@ -361,22 +289,3 @@ winbox_update_factor <- function(id, ) } - -#' Make unique variable names -#' -#' Helper function to create new variable names that are unique -#' given a set of existing names (in a data set, for example). -#' If a variable name already exists, a number will be appended. -#' -#' @param new a vector of proposed new variable names -#' @param existing a vector of existing variable names -#' @return a vector of unique new variable names -#' @examples -#' unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z")) -#' -#' @export -unique_names <- function(new, existing = character()) { - new_names <- make.unique(c(existing, new), sep = "_") - - new_names[-seq_along(existing)] -} diff --git a/SESSION.md b/SESSION.md index 41b64837..80527531 100644 --- a/SESSION.md +++ b/SESSION.md @@ -1,21 +1,21 @@ -------------------------------------------------------------------------------- -------------------------------- R environment --------------------------------- -------------------------------------------------------------------------------- -|setting |value | -|:-----------|:----------------------------------------------| -|version |R version 4.4.1 (2024-06-14) | -|os |macOS 26.1 | -|system |aarch64, darwin20 | -|ui |RStudio | -|language |(EN) | -|collate |en_US.UTF-8 | -|ctype |en_US.UTF-8 | -|tz |Europe/Copenhagen | -|date |2025-12-02 | -|rstudio |2025.09.2+418 Cucumberleaf Sunflower (desktop) | -|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | -|quarto |1.7.30 @ /usr/local/bin/quarto | -|FreesearchR |25.12.1.251202 | +|setting |value | +|:-----------|:------------------------------------------| +|version |R version 4.4.1 (2024-06-14) | +|os |macOS 15.7.1 | +|system |aarch64, darwin20 | +|ui |RStudio | +|language |(EN) | +|collate |en_US.UTF-8 | +|ctype |en_US.UTF-8 | +|tz |Europe/Copenhagen | +|date |2025-11-09 | +|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.11.1.251109 | -------------------------------------------------------------------------------- @@ -83,7 +83,7 @@ |foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) | |foreign |0.8-90 |2025-03-31 |CRAN (R 4.4.1) | |Formula |1.2-5 |2023-02-24 |CRAN (R 4.4.1) | -|FreesearchR |25.12.1 |NA |NA | +|FreesearchR |25.11.1 |NA |NA | |fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | |gdtools |0.4.2 |2025-03-27 |CRAN (R 4.4.1) | |generics |0.1.4 |2025-05-09 |CRAN (R 4.4.1) | @@ -117,9 +117,11 @@ |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) | diff --git a/app_docker/app.R b/app_docker/app.R index 5e769d05..0f193d1d 100644 --- a/app_docker/app.R +++ b/app_docker/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpyM6210/file126781ad7585e.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpFr1XvR/file15f634a33505f.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.12.1' +app_version <- function()'25.11.1' ######## @@ -1656,11 +1656,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } ) - data <- append_column(data, - column = new_variable, - name = unique_names(paste0(variable, "_cut"), - existing = names(data)), - index = "right") + data <- append_column(data, column = new_variable, name = paste0(variable, "_cut"), index = "right") code <- rlang::call2( "append_column", @@ -4064,82 +4060,18 @@ pipe_string <- function(data, collapse = "|>\n") { #' @examples #' list( #' as.symbol(paste0("mtcars$", "mpg")), -#' rlang::call2(.fn = "select", !!!list(c("cyl", "di sp")), .ns = "dplyr"), +#' rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"), #' rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") #' ) |> #' merge_expression() |> #' expression_string() expression_string <- function(data, assign.str = "") { exp.str <- if (is.call(data)) deparse(data) else data - + # browser() out <- paste0(assign.str, gsub("%>%", "|>\n", paste(gsub('"', "'", paste(exp.str, collapse = "")), collapse = ""))) - out <- collapse_spaces(out,preserve_newlines = FALSE) - gsub("`", "", out) + gsub(" |`", "", out) } -#' Substitue spaces/tabs with single space excluding text within quotes -#' -#' @description -#' Written assisted by Claude.ai. It is long and possibly too complicated, -#' but it works -#' -#' -#' @param x character string -#' @param preserve_newlines flag to preserve new lines -#' -#' @returns character string -#' -#' @examples -#' collapse_spaces(c("cyl", "di sp","s e d","d e'dl e'")) -collapse_spaces <- function(x, preserve_newlines = TRUE) { - # Function to process a single string - process_string <- function(text) { - # Pattern to match single-quoted strings - quote_pattern <- "'[^']*'" - - # Find all quoted strings and their positions - quotes <- gregexpr(quote_pattern, text, perl = TRUE)[[1]] - - if (quotes[1] == -1) { - # No quoted strings, process entire text - if (preserve_newlines) { - return(gsub("[ \\t]{1,}", " ", text)) - } else { - return(gsub("\\s{1,}", " ", text)) - } - } - - # Extract quoted strings - quote_lengths <- attr(quotes, "match.length") - quoted_parts <- substring(text, quotes, quotes + quote_lengths - 1) - - # Create placeholders - placeholders <- paste0("__QUOTE_", seq_along(quoted_parts), "__") - - # Replace quoted strings with placeholders - result <- text - for (i in seq_along(quoted_parts)) { - result <- sub(quote_pattern, placeholders[i], result, perl = TRUE) - } - - # Collapse spaces in non-quoted parts - if (preserve_newlines) { - result <- gsub("[ \\t]{2,}", "", result) - } else { - result <- gsub("\\s{2,}", "", result) - } - - # Restore quoted strings - for (i in seq_along(quoted_parts)) { - result <- sub(placeholders[i], quoted_parts[i], result, fixed = TRUE) - } - - return(result) - } - - # Apply to each element of vector - sapply(x, process_string, USE.NAMES = FALSE) -} #' Very simple function to remove nested lists, like when uploading .rds #' @@ -4369,7 +4301,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.12.1-251202' +hosted_version <- function()'v25.11.1-251109' ######## @@ -9481,25 +9413,15 @@ prismCodeBlock <- function(code) { prismDependencies <- tags$head( tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/prism.min.js"), - tags$link( - rel = "stylesheet", type = "text/css", - href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css" - ), - tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js"), - tags$link( - rel = "stylesheet", - href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.css" - ), - tags$script( - src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.js" - ), - tags$script( - src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/copy-to-clipboard/prism-copy-to-clipboard.min.js" - ) + tags$link(rel = "stylesheet", type = "text/css", + href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css") ) +prismRDependency <- tags$head( + tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js") +) -html_code_wrap <- function(string, lang = "r") { +html_code_wrap <- function(string,lang="r"){ glue::glue("
{string}
   
") } @@ -10300,6 +10222,7 @@ ui_elements <- function(selection) { #### Current file: /Users/au301842/FreesearchR/R//update-factor-ext.R ######## + ## Works, but not implemented ## ## These edits mainly allows for @@ -10402,6 +10325,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { moduleServer( id, function(input, output, session) { + rv <- reactiveValues(data = NULL, data_grid = NULL) bindEvent(observe({ @@ -10507,37 +10431,19 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) grid <- req(input$grid_data) - - parameters <- list( - variable = variable, - new_variable = isTRUE(input$new_var) | any(grid[["Var1_toset"]] == "New label"), - new_levels = as.character(grid[["Var1"]]), - new_labels = as.character(grid[["Var1_toset"]]), - ignore = "New label" + name_var <- if (isTRUE(input$new_var)) { + paste0(variable, "_updated") + } else { + variable + } + data[[name_var]] <- factor( + as.character(data[[variable]]), + levels = grid[["Var1"]] ) - - data <- tryCatch( - { - rlang::exec( - factor_new_levels_labels, - !!!modifyList(parameters, - val = list(data = data) - ) - ) - }, - error = function(err) { - showNotification(paste("We encountered the following error creating the new factor:", err), type = "err") - } + data[[name_var]] <- factor( + data[[variable]], + labels = ifelse(grid[["Var1_toset"]]=="New label",grid[["Var1"]],grid[["Var1_toset"]]) ) - - # browser() - code <- rlang::call2( - "factor_new_levels_labels", - !!!parameters, - .ns = "FreesearchR" - ) - attr(data, "code") <- code - data }) @@ -10549,62 +10455,6 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { ) } -#' Simple function to apply new levels and/or labels to factor -#' -#' @param variable factor variable -#' @param new_level new levels, same length as original -#' @param new_label new labels, same length as original -#' @param ignore character string to ignore in new labels -#' -#' @returns factor -#' @export -#' -#' @examples -#' data_n <- mtcars -#' data_n$cyl <- factor(data_n$cyl) -#' factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label")) -factor_new_levels_labels <- function( - data, - variable, - new_variable = TRUE, - new_levels = NULL, - new_labels = NULL, - ignore = "New label") { - if (!is.factor(data[[variable]])) { - return(data) - } - - if (is.null(new_levels)) { - new_levels <- levels(data[[variable]]) - } - - if (is.null(new_labels)) { - new_labels <- labels(data[[variable]]) - } - - with_level <- factor( - as.character(data[[variable]]), - levels = new_levels - ) - with_label <- factor( - with_level, - labels = ifelse(new_labels == "New label", new_levels, new_labels) - ) - - # browser() - - if (isTRUE(new_variable)) { - append_column( - data = data, - column = with_label, - name = unique_names(new = paste0(variable, "_updated"), existing = names(data)) - ) - } else { - data[[variable]] <- new_variable - data - } -} - #' @inheritParams shiny::modalDialog @@ -10664,25 +10514,6 @@ winbox_update_factor <- function(id, } -#' Make unique variable names -#' -#' Helper function to create new variable names that are unique -#' given a set of existing names (in a data set, for example). -#' If a variable name already exists, a number will be appended. -#' -#' @param new a vector of proposed new variable names -#' @param existing a vector of existing variable names -#' @return a vector of unique new variable names -#' @examples -#' unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z")) -#' -#' @export -unique_names <- function(new, existing = character()) { - new_names <- make.unique(c(existing, new), sep = "_") - - new_names[-seq_along(existing)] -} - ######## #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R @@ -11986,6 +11817,7 @@ make_validation_alerts <- function(data) { #' @returns Shiny ui module #' @export #' +#' @example examples/visual_summary_demo.R visual_summary_ui <- function(id) { ns <- shiny::NS(id) @@ -12079,6 +11911,14 @@ modal_visual_summary <- function(id, #' @returns An [apexchart()] `htmlwidget` object. #' @export #' +#' @examples +#' data_demo <- mtcars +#' data_demo[2:4, "cyl"] <- NA +#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot() +#' data_demo |> missings_apex_plot() +#' mtcars |> missings_apex_plot(animation = TRUE) +#' # dplyr::storms |> missings_apex_plot() +#' visdat::vis_dat(dplyr::storms) missings_apex_plot <- function(data, animation = FALSE, ...) { l <- data_summary_gather(data, ...) @@ -12129,6 +11969,14 @@ missings_apex_plot <- function(data, animation = FALSE, ...) { #' @returns ggplot2 object #' @export #' +#' @examples +#' data_demo <- mtcars +#' data_demo[sample(1:32, 10), "cyl"] <- NA +#' data_demo[sample(1:32, 8), "vs"] <- NA +#' visual_summary(data_demo) +#' visual_summary(data_demo, palette.fun = scales::hue_pal()) +#' visual_summary(dplyr::storms, summary.fun = data_type) +#' visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class") visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...) { l <- data_summary_gather(data, ...) @@ -12180,7 +12028,7 @@ visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ... #' @export #' #' @examples -#' mtcars |> data_summary_gather() |> names() +#' mtcars |> data_summary_gather() data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis, na.label = "NA", ...) { df_plot <- setNames(data, unique_short(names(data))) |> purrr::map_df(\(x){ @@ -12460,6 +12308,7 @@ ui <- bslib::page_fixed( usei18n(i18n), ## Code formatting dependencies prismDependencies, + prismRDependency, # html_dependency_FreesearchR(), ## Version dependent header header_include(), @@ -12964,12 +12813,10 @@ server <- function(input, output, session) { shiny::observeEvent( input$modal_update, - # datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels")) - modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels")) + datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels")) ) - # data_modal_update <- datamods::update_factor_server( - data_modal_update <- update_factor_server( + data_modal_update <- datamods::update_factor_server( id = "modal_update", data_r = reactive(rv$data) ) @@ -13418,19 +13265,17 @@ server <- function(input, output, session) { output$detail_level <- shiny::renderUI({ - shiny::radioButtons( - inputId = "detail_level", - label = i18n$t("Level of detail"), - selected = "minimal", - inline = TRUE, choiceValues = c( - "minimal", - "extended" - ), - choiceNames = c( - i18n$t("Minimal"), - i18n$t("Extensive") - ) + shiny::radioButtons( + inputId = "detail_level", + label = i18n$t("Level of detail"), + selected = "minimal", + inline = TRUE,choiceValues = c("minimal", + "extended"), + choiceNames = c( + i18n$t("Minimal"), + i18n$t("Extensive") ) + ) }) diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 6278a8e3..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//RtmpyM6210/file1267841f7ff86.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.12.1' +app_version <- function()'25.10.5' ######## @@ -83,6 +83,7 @@ app_version <- function()'25.12.1' #' mtcars |> baseline_table() #' mtcars |> baseline_table(fun.args = list(by = "gear")) baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) { + out <- do.call(fun, c(list(data = data), fun.args)) return(out) } @@ -93,26 +94,19 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, #' #' @param data data #' @param ... passed as fun.arg to baseline_table() +#' @param strat.var grouping/strat variable #' @param add.p add comparison/p-value #' @param add.overall add overall column -#' @param by.var specify stratification variable -#' @param theme set table theme -#' @param detail_level specify detail level. Either "minimal" or "extended". #' #' @returns gtsummary table list object #' @export #' #' @examples #' mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes") -#' mtcars |> create_baseline(by.var = "gear", detail_level = "extended") -#' mtcars |> create_baseline(by.var = "gear", detail_level = "extended",type = list(gtsummary::all_dichotomous() ~ "categorical"),theme="nejm") -#' #' create_baseline(default_parsing(mtcars), by.var = "am", add.p = FALSE, add.overall = FALSE, theme = "lancet") -create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon"), detail_level = c("minimal", "extended")) { +create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon")) { theme <- match.arg(theme) - detail_level <- match.arg(detail_level) - if (by.var == "none" | !by.var %in% names(data)) { by.var <- NULL } @@ -130,32 +124,11 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS args <- list(...) - # browser() - - if (!any(hasName(args, c("type", "statistic")))) { - if (detail_level == "extended") { - args <- - modifyList( - args, - list( - type = list(gtsummary::all_continuous() ~ "continuous2", - gtsummary::all_dichotomous() ~ "categorical"), - statistic = list(gtsummary::all_continuous() ~ c( - "{median} ({p25}, {p75})", - "{mean} ({sd})", - "{min}, {max}")) - ) - ) - } - } - parameters <- list( data = data, - fun.args = purrr::list_flatten(list(by = by.var, args)) + fun.args = list(by = by.var, ...) ) - - # browser() out <- do.call( baseline_table, parameters @@ -1656,11 +1629,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } ) - data <- append_column(data, - column = new_variable, - name = unique_names(paste0(variable, "_cut"), - existing = names(data)), - index = "right") + data <- append_column(data, column = new_variable, name = paste0(variable, "_cut"), index = "right") code <- rlang::call2( "append_column", @@ -4064,82 +4033,18 @@ pipe_string <- function(data, collapse = "|>\n") { #' @examples #' list( #' as.symbol(paste0("mtcars$", "mpg")), -#' rlang::call2(.fn = "select", !!!list(c("cyl", "di sp")), .ns = "dplyr"), +#' rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"), #' rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") #' ) |> #' merge_expression() |> #' expression_string() expression_string <- function(data, assign.str = "") { exp.str <- if (is.call(data)) deparse(data) else data - + # browser() out <- paste0(assign.str, gsub("%>%", "|>\n", paste(gsub('"', "'", paste(exp.str, collapse = "")), collapse = ""))) - out <- collapse_spaces(out,preserve_newlines = FALSE) - gsub("`", "", out) + gsub(" |`", "", out) } -#' Substitue spaces/tabs with single space excluding text within quotes -#' -#' @description -#' Written assisted by Claude.ai. It is long and possibly too complicated, -#' but it works -#' -#' -#' @param x character string -#' @param preserve_newlines flag to preserve new lines -#' -#' @returns character string -#' -#' @examples -#' collapse_spaces(c("cyl", "di sp","s e d","d e'dl e'")) -collapse_spaces <- function(x, preserve_newlines = TRUE) { - # Function to process a single string - process_string <- function(text) { - # Pattern to match single-quoted strings - quote_pattern <- "'[^']*'" - - # Find all quoted strings and their positions - quotes <- gregexpr(quote_pattern, text, perl = TRUE)[[1]] - - if (quotes[1] == -1) { - # No quoted strings, process entire text - if (preserve_newlines) { - return(gsub("[ \\t]{1,}", " ", text)) - } else { - return(gsub("\\s{1,}", " ", text)) - } - } - - # Extract quoted strings - quote_lengths <- attr(quotes, "match.length") - quoted_parts <- substring(text, quotes, quotes + quote_lengths - 1) - - # Create placeholders - placeholders <- paste0("__QUOTE_", seq_along(quoted_parts), "__") - - # Replace quoted strings with placeholders - result <- text - for (i in seq_along(quoted_parts)) { - result <- sub(quote_pattern, placeholders[i], result, perl = TRUE) - } - - # Collapse spaces in non-quoted parts - if (preserve_newlines) { - result <- gsub("[ \\t]{2,}", "", result) - } else { - result <- gsub("\\s{2,}", "", result) - } - - # Restore quoted strings - for (i in seq_along(quoted_parts)) { - result <- sub(placeholders[i], quoted_parts[i], result, fixed = TRUE) - } - - return(result) - } - - # Apply to each element of vector - sapply(x, process_string, USE.NAMES = FALSE) -} #' Very simple function to remove nested lists, like when uploading .rds #' @@ -4369,7 +4274,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.12.1-251202' +hosted_version <- function()'v25.10.5-251031' ######## @@ -9481,25 +9386,15 @@ prismCodeBlock <- function(code) { prismDependencies <- tags$head( tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/prism.min.js"), - tags$link( - rel = "stylesheet", type = "text/css", - href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css" - ), - tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js"), - tags$link( - rel = "stylesheet", - href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.css" - ), - tags$script( - src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/toolbar/prism-toolbar.min.js" - ), - tags$script( - src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/copy-to-clipboard/prism-copy-to-clipboard.min.js" - ) + tags$link(rel = "stylesheet", type = "text/css", + href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css") ) +prismRDependency <- tags$head( + tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-r.min.js") +) -html_code_wrap <- function(string, lang = "r") { +html_code_wrap <- function(string,lang="r"){ glue::glue("
{string}
   
") } @@ -10019,17 +9914,6 @@ ui_elements <- function(selection) { value = "acc_pan_chars", title = "Settings", icon = bsicons::bs_icon("table"), - # vectorSelectInput( - # inputId = "baseline_theme", - # selected = "none", - # label = i18n$t("Select table theme"), - # choices = c( - # "The Journal of the American Medical Association" = "jama", - # "The Lancet"="lancet", - # "The New England Journal of Medicine" = "nejm", - # "The Quarterly Journal of Economics" = "qjecon") - # ), - shiny::uiOutput("detail_level"), shiny::uiOutput("strat_var"), shiny::helpText(i18n$t("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.")), shiny::conditionalPanel( @@ -10300,6 +10184,7 @@ ui_elements <- function(selection) { #### Current file: /Users/au301842/FreesearchR/R//update-factor-ext.R ######## + ## Works, but not implemented ## ## These edits mainly allows for @@ -10402,6 +10287,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { moduleServer( id, function(input, output, session) { + rv <- reactiveValues(data = NULL, data_grid = NULL) bindEvent(observe({ @@ -10507,37 +10393,19 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) grid <- req(input$grid_data) - - parameters <- list( - variable = variable, - new_variable = isTRUE(input$new_var) | any(grid[["Var1_toset"]] == "New label"), - new_levels = as.character(grid[["Var1"]]), - new_labels = as.character(grid[["Var1_toset"]]), - ignore = "New label" + name_var <- if (isTRUE(input$new_var)) { + paste0(variable, "_updated") + } else { + variable + } + data[[name_var]] <- factor( + as.character(data[[variable]]), + levels = grid[["Var1"]] ) - - data <- tryCatch( - { - rlang::exec( - factor_new_levels_labels, - !!!modifyList(parameters, - val = list(data = data) - ) - ) - }, - error = function(err) { - showNotification(paste("We encountered the following error creating the new factor:", err), type = "err") - } + data[[name_var]] <- factor( + data[[variable]], + labels = ifelse(grid[["Var1_toset"]]=="New label",grid[["Var1"]],grid[["Var1_toset"]]) ) - - # browser() - code <- rlang::call2( - "factor_new_levels_labels", - !!!parameters, - .ns = "FreesearchR" - ) - attr(data, "code") <- code - data }) @@ -10549,62 +10417,6 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { ) } -#' Simple function to apply new levels and/or labels to factor -#' -#' @param variable factor variable -#' @param new_level new levels, same length as original -#' @param new_label new labels, same length as original -#' @param ignore character string to ignore in new labels -#' -#' @returns factor -#' @export -#' -#' @examples -#' data_n <- mtcars -#' data_n$cyl <- factor(data_n$cyl) -#' factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label")) -factor_new_levels_labels <- function( - data, - variable, - new_variable = TRUE, - new_levels = NULL, - new_labels = NULL, - ignore = "New label") { - if (!is.factor(data[[variable]])) { - return(data) - } - - if (is.null(new_levels)) { - new_levels <- levels(data[[variable]]) - } - - if (is.null(new_labels)) { - new_labels <- labels(data[[variable]]) - } - - with_level <- factor( - as.character(data[[variable]]), - levels = new_levels - ) - with_label <- factor( - with_level, - labels = ifelse(new_labels == "New label", new_levels, new_labels) - ) - - # browser() - - if (isTRUE(new_variable)) { - append_column( - data = data, - column = with_label, - name = unique_names(new = paste0(variable, "_updated"), existing = names(data)) - ) - } else { - data[[variable]] <- new_variable - data - } -} - #' @inheritParams shiny::modalDialog @@ -10664,25 +10476,6 @@ winbox_update_factor <- function(id, } -#' Make unique variable names -#' -#' Helper function to create new variable names that are unique -#' given a set of existing names (in a data set, for example). -#' If a variable name already exists, a number will be appended. -#' -#' @param new a vector of proposed new variable names -#' @param existing a vector of existing variable names -#' @return a vector of unique new variable names -#' @examples -#' unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z")) -#' -#' @export -unique_names <- function(new, existing = character()) { - new_names <- make.unique(c(existing, new), sep = "_") - - new_names[-seq_along(existing)] -} - ######## #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R @@ -11986,6 +11779,7 @@ make_validation_alerts <- function(data) { #' @returns Shiny ui module #' @export #' +#' @example examples/visual_summary_demo.R visual_summary_ui <- function(id) { ns <- shiny::NS(id) @@ -12079,6 +11873,14 @@ modal_visual_summary <- function(id, #' @returns An [apexchart()] `htmlwidget` object. #' @export #' +#' @examples +#' data_demo <- mtcars +#' data_demo[2:4, "cyl"] <- NA +#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot() +#' data_demo |> missings_apex_plot() +#' mtcars |> missings_apex_plot(animation = TRUE) +#' # dplyr::storms |> missings_apex_plot() +#' visdat::vis_dat(dplyr::storms) missings_apex_plot <- function(data, animation = FALSE, ...) { l <- data_summary_gather(data, ...) @@ -12129,6 +11931,14 @@ missings_apex_plot <- function(data, animation = FALSE, ...) { #' @returns ggplot2 object #' @export #' +#' @examples +#' data_demo <- mtcars +#' data_demo[sample(1:32, 10), "cyl"] <- NA +#' data_demo[sample(1:32, 8), "vs"] <- NA +#' visual_summary(data_demo) +#' visual_summary(data_demo, palette.fun = scales::hue_pal()) +#' visual_summary(dplyr::storms, summary.fun = data_type) +#' visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class") visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...) { l <- data_summary_gather(data, ...) @@ -12180,7 +11990,7 @@ visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ... #' @export #' #' @examples -#' mtcars |> data_summary_gather() |> names() +#' mtcars |> data_summary_gather() data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis, na.label = "NA", ...) { df_plot <- setNames(data, unique_short(names(data))) |> purrr::map_df(\(x){ @@ -12460,6 +12270,7 @@ ui <- bslib::page_fixed( usei18n(i18n), ## Code formatting dependencies prismDependencies, + prismRDependency, # html_dependency_FreesearchR(), ## Version dependent header header_include(), @@ -12964,12 +12775,10 @@ server <- function(input, output, session) { shiny::observeEvent( input$modal_update, - # datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels")) - modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels")) + datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels")) ) - # data_modal_update <- datamods::update_factor_server( - data_modal_update <- update_factor_server( + data_modal_update <- datamods::update_factor_server( id = "modal_update", data_r = reactive(rv$data) ) @@ -13392,7 +13201,7 @@ server <- function(input, output, session) { columnSelectInput( inputId = "strat_var", selected = "none", - label = i18n$t("Select variable to stratify baseline"), + label = "Select variable to stratify baseline", data = shiny::reactive(rv$data_filtered)(), col_subset = c( "none", @@ -13401,39 +13210,6 @@ server <- function(input, output, session) { ) }) - # output$baseline_theme <- shiny::renderUI({ - # choices <- - # - # vectorSelectInput( - # inputId = "baseline_theme", - # selected = "none", - # label = i18n$t("Select table theme"), - # choices = c( - # "The Journal of the American Medical Association" = "jama", - # "The Lancet"="lancet", - # "The New England Journal of Medicine" = "nejm", - # "The Quarterly Journal of Economics" = "qjecon") - # ) - # }) - - - output$detail_level <- shiny::renderUI({ - shiny::radioButtons( - inputId = "detail_level", - label = i18n$t("Level of detail"), - selected = "minimal", - inline = TRUE, choiceValues = c( - "minimal", - "extended" - ), - choiceNames = c( - i18n$t("Minimal"), - i18n$t("Extensive") - ) - ) - }) - - ############################################################################## ######### ######### Descriptive evaluations @@ -13459,39 +13235,30 @@ server <- function(input, output, session) { # }) - - shiny::observeEvent( list( input$act_eval ), { shiny::req(input$strat_var) - # shiny::req(input$baseline_theme) - shiny::req(input$detail_level) shiny::req(rv$list$data) - - parameters <- list( by.var = input$strat_var, add.p = input$add_p == "yes", - add.overall = TRUE, - # theme = input$baseline_theme, - detail_level = input$detail_level + 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") + if (is.factor(.x)){ + cut_var(.x,breaks=20,type="top") } else { .x } - }) |> - dplyr::bind_cols() + }) |> dplyr::bind_cols() # Attempt to introduce error on analysing too large dataset # tryCatch( diff --git a/man/collapse_spaces.Rd b/man/collapse_spaces.Rd deleted file mode 100644 index f93d5415..00000000 --- a/man/collapse_spaces.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R -\name{collapse_spaces} -\alias{collapse_spaces} -\title{Substitue spaces/tabs with single space excluding text within quotes} -\usage{ -collapse_spaces(x, preserve_newlines = TRUE) -} -\arguments{ -\item{x}{character string} - -\item{preserve_newlines}{flag to preserve new lines} -} -\value{ -character string -} -\description{ -Written assisted by Claude.ai. It is long and possibly too complicated, -but it works -} -\examples{ -collapse_spaces(c("cyl", "di sp","s e d","d e'dl e'")) -} diff --git a/man/expression_string.Rd b/man/expression_string.Rd index 24487f0e..82719129 100644 --- a/man/expression_string.Rd +++ b/man/expression_string.Rd @@ -18,7 +18,7 @@ Deparses expression as string, substitutes native pipe and adds assign \examples{ list( as.symbol(paste0("mtcars$", "mpg")), - rlang::call2(.fn = "select", !!!list(c("cyl", "di sp")), .ns = "dplyr"), + rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"), rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") ) |> merge_expression() |> diff --git a/man/factor_new_levels_labels.Rd b/man/factor_new_levels_labels.Rd deleted file mode 100644 index 8a360e2a..00000000 --- a/man/factor_new_levels_labels.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/update-factor-ext.R -\name{factor_new_levels_labels} -\alias{factor_new_levels_labels} -\title{Simple function to apply new levels and/or labels to factor} -\usage{ -factor_new_levels_labels( - data, - variable, - new_variable = TRUE, - new_levels = NULL, - new_labels = NULL, - ignore = "New label" -) -} -\arguments{ -\item{variable}{factor variable} - -\item{ignore}{character string to ignore in new labels} - -\item{new_level}{new levels, same length as original} - -\item{new_label}{new labels, same length as original} -} -\value{ -factor -} -\description{ -Simple function to apply new levels and/or labels to factor -} -\examples{ -data_n <- mtcars -data_n$cyl <- factor(data_n$cyl) -factor_new_levels_labels(data_n, "cyl", new_labels = c("four", "New label", "New label")) -} diff --git a/man/unique_names.Rd b/man/unique_names.Rd deleted file mode 100644 index c6736652..00000000 --- a/man/unique_names.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/update-factor-ext.R -\name{unique_names} -\alias{unique_names} -\title{Make unique variable names} -\usage{ -unique_names(new, existing = character()) -} -\arguments{ -\item{new}{a vector of proposed new variable names} - -\item{existing}{a vector of existing variable names} -} -\value{ -a vector of unique new variable names -} -\description{ -Helper function to create new variable names that are unique -given a set of existing names (in a data set, for example). -If a variable name already exists, a number will be appended. -} -\examples{ -unique_names(c("var_x", "var_y", "var_x"), c("var_x", "var_z")) - -}