From 987069dd90c91d2dfed64aaf8435da4c96b6970a Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 2 Dec 2025 13:58:37 +0100 Subject: [PATCH] feat: change to custom function for modifying factors --- R/update-factor-ext.R | 117 ++++++++++++++++++++++++++++---- man/collapse_spaces.Rd | 23 +++++++ man/expression_string.Rd | 2 +- man/factor_new_levels_labels.Rd | 35 ++++++++++ man/unique_names.Rd | 25 +++++++ 5 files changed, 188 insertions(+), 14 deletions(-) create mode 100644 man/collapse_spaces.Rd create mode 100644 man/factor_new_levels_labels.Rd create mode 100644 man/unique_names.Rd diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R index 7c1236e0..a895350f 100644 --- a/R/update-factor-ext.R +++ b/R/update-factor-ext.R @@ -1,4 +1,3 @@ - ## Works, but not implemented ## ## These edits mainly allows for @@ -101,7 +100,6 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { moduleServer( id, function(input, output, session) { - rv <- reactiveValues(data = NULL, data_grid = NULL) bindEvent(observe({ @@ -207,19 +205,37 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) grid <- req(input$grid_data) - name_var <- if (isTRUE(input$new_var)) { - paste0(variable, "_updated") - } else { - variable - } - data[[name_var]] <- factor( - as.character(data[[variable]]), - levels = grid[["Var1"]] + + 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" ) - data[[name_var]] <- factor( - data[[variable]], - labels = ifelse(grid[["Var1_toset"]]=="New label",grid[["Var1"]],grid[["Var1_toset"]]) + + 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") + } ) + + # browser() + code <- rlang::call2( + "factor_new_levels_labels", + !!!parameters, + .ns = "FreesearchR" + ) + attr(data, "code") <- code + data }) @@ -231,6 +247,62 @@ 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 @@ -289,3 +361,22 @@ 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/man/collapse_spaces.Rd b/man/collapse_spaces.Rd new file mode 100644 index 00000000..f93d5415 --- /dev/null +++ b/man/collapse_spaces.Rd @@ -0,0 +1,23 @@ +% 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 82719129..24487f0e 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", "disp")), .ns = "dplyr"), + rlang::call2(.fn = "select", !!!list(c("cyl", "di sp")), .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 new file mode 100644 index 00000000..8a360e2a --- /dev/null +++ b/man/factor_new_levels_labels.Rd @@ -0,0 +1,35 @@ +% 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 new file mode 100644 index 00000000..c6736652 --- /dev/null +++ b/man/unique_names.Rd @@ -0,0 +1,25 @@ +% 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")) + +}