From b5969328e10f361833589a48ba709fc559814c43 Mon Sep 17 00:00:00 2001 From: jospueyo Date: Sun, 21 Jan 2024 16:32:39 +0100 Subject: [PATCH] #563 add set_labels to clean names --- DESCRIPTION | 3 ++- NEWS.md | 4 +++- R/clean_names.R | 17 ++++++++++++++--- man/clean_names.Rd | 8 +++++--- man/janitor-package.Rd | 1 + tests/testthat/test-clean-names.R | 31 ++++++++++++++++++++++++++++++- 6 files changed, 55 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a5de4660..959ccfb6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,7 +8,8 @@ Authors@R: c( person("Ryan", "Knight", , "ryangknight@gmail.com", role = "ctb"), person("Malte", "Grosser", , "malte.grosser@gmail.com", role = "ctb"), person("Jonathan", "Zadra", , "jonathan.zadra@sorensonimpact.com", role = "ctb"), - person("Olivier", "Roy", role = "ctb") + person("Olivier", "Roy", role = "ctb"), + person("Josep", "Pueyo-Ros", "josep.pueyo@udg.edu", role = "ctb") ) Description: The main janitor functions can: perfectly format data.frame column names; provide quick counts of variable combinations (i.e., diff --git a/NEWS.md b/NEWS.md index 3e387eb8..d00285fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,8 @@ These are all minor breaking changes resulting from enhancements and are not exp * The new function `excel_time_to_numeric()` converts times from Excel that do not have accompanying dates into a number of seconds. (#245, thanks to **@billdenney** for the feature.) +* A new argument `set_labels` to `clean_names()` stores the old names as labels in each column. Variable labels are visualized in Rstudio's data viewer or used by default by some packages such as `gt` instead of variable names. Labels can also be used in ggplot labels thanks to the function `easy_labs()` in the `ggeasy` package. Read this wonderful [post](https://www.pipinghotdata.com/posts/2022-09-13-the-case-for-variable-labels-in-r/) for more info about column labels. (#563, thanks to **@jospueyo** for the feature). + ## Bug fixes * `adorn_totals("row")` now succeeds if the new `name` of the totals row is already a factor level of the input data.frame (#529, thanks @egozoglu for reporting). @@ -22,7 +24,7 @@ These are all minor breaking changes resulting from enhancements and are not exp * `get_one_to_one()` no longer errors with near-equal values that become identical factor levels (fix #543, thanks to @olivroy for reporting) -# Refactoring +## Refactoring * Remove dplyr verbs superseded in dplyr 1.0.0 (#547, @olivroy) diff --git a/R/clean_names.R b/R/clean_names.R index b8fe3b5f..c88f031b 100644 --- a/R/clean_names.R +++ b/R/clean_names.R @@ -24,6 +24,7 @@ #' (characters) to "u". #' #' @param dat The input `data.frame`. +#' @param set_labels If set to `TRUE`, old names are stored as labels in each column of `dat`. #' @inheritDotParams make_clean_names -string #' @return A `data.frame` with clean names. #' @@ -65,13 +66,13 @@ #' x %>% #' clean_names(case = "upper_camel", abbreviations = c("ID", "DOB")) #' -clean_names <- function(dat, ...) { +clean_names <- function(dat, ..., set_labels = FALSE) { UseMethod("clean_names") } #' @rdname clean_names #' @export -clean_names.default <- function(dat, ...) { +clean_names.default <- function(dat, ..., set_labels = FALSE) { if (is.null(names(dat)) && is.null(dimnames(dat))) { stop( "`clean_names()` requires that either names or dimnames be non-null.", @@ -81,14 +82,19 @@ clean_names.default <- function(dat, ...) { if (is.null(names(dat))) { dimnames(dat) <- lapply(dimnames(dat), make_clean_names, ...) } else { + if (set_labels){ + old_names <- names(dat) + for (i in seq_along(old_names)) attr(dat[[i]], "label") <- old_names[[i]] + } names(dat) <- make_clean_names(names(dat), ...) + } dat } #' @rdname clean_names #' @export -clean_names.sf <- function(dat, ...) { +clean_names.sf <- function(dat, ..., set_labels = FALSE) { if (!requireNamespace("sf", quietly = TRUE)) { # nocov start stop( "Package 'sf' needed for this function to work. Please install it.", @@ -103,6 +109,10 @@ clean_names.sf <- function(dat, ...) { sf_cleaned <- make_clean_names(sf_names[1:n_cols], ...) # rename original df names(dat)[1:n_cols] <- sf_cleaned + + if(set_labels){ + for (i in seq_along(sf_names[1:n_cols])) attr(dat[[i]], "label") <- sf_names[[i]] + } return(dat) } @@ -116,6 +126,7 @@ clean_names.tbl_graph <- function(dat, ...) { call. = FALSE ) } # nocov end + dplyr::rename_all(dat, .funs = make_clean_names, ...) } diff --git a/man/clean_names.Rd b/man/clean_names.Rd index 23579ffb..a7a18e10 100644 --- a/man/clean_names.Rd +++ b/man/clean_names.Rd @@ -8,11 +8,11 @@ \alias{clean_names.tbl_lazy} \title{Cleans names of an object (usually a data.frame).} \usage{ -clean_names(dat, ...) +clean_names(dat, ..., set_labels = FALSE) -\method{clean_names}{default}(dat, ...) +\method{clean_names}{default}(dat, ..., set_labels = FALSE) -\method{clean_names}{sf}(dat, ...) +\method{clean_names}{sf}(dat, ..., set_labels = FALSE) \method{clean_names}{tbl_graph}(dat, ...) @@ -65,6 +65,8 @@ You should use this feature with care in case of \code{case = "parsed"}, \code{c might not always be what is intended. In this case you can make usage of the option to supply named elements and specify the transliterations yourself.} \item{\code{numerals}}{A character specifying the alignment of numerals (\code{"middle"}, \code{left}, \code{right}, \code{asis} or \code{tight}). I.e. \code{numerals = "left"} ensures that no output separator is in front of a digit.} }} + +\item{set_labels}{If set to \code{TRUE}, old names are stored as labels in each column of \code{dat}.} } \value{ A \code{data.frame} with clean names. diff --git a/man/janitor-package.Rd b/man/janitor-package.Rd index f58f513a..568b5f32 100644 --- a/man/janitor-package.Rd +++ b/man/janitor-package.Rd @@ -49,6 +49,7 @@ Other contributors: \item Malte Grosser \email{malte.grosser@gmail.com} [contributor] \item Jonathan Zadra \email{jonathan.zadra@sorensonimpact.com} [contributor] \item Olivier Roy [contributor] + \item Josep josep.pueyo@udg.edu Pueyo-Ros [contributor] } } diff --git a/tests/testthat/test-clean-names.R b/tests/testthat/test-clean-names.R index 96e8809c..3f4dc8f8 100644 --- a/tests/testthat/test-clean-names.R +++ b/tests/testthat/test-clean-names.R @@ -186,6 +186,35 @@ test_that("do not create duplicates (fix #251)", { ) }) +test_that("labels are created in default and sf methods (feature request #563)", { + dat_df <- dplyr::tibble(`a a` = c(11, 22), `b b` = c(2, 3)) + dat_df_clean_labels <- clean_names(dat_df, set_labels = TRUE) + dat_df_clean <- clean_names(dat_df) + + dat_sf <- dat_df + dat_sf$x <- c(1,2) + dat_sf$y = c(1,2) + dat_sf <- sf::st_as_sf(dat_sf, coords = c("x", "y")) + dat_sf_clean_labels <- clean_names(dat_sf, set_labels = TRUE) + dat_sf_clean <- clean_names(dat_sf) + + for (i in seq_along(names(dat_df))){ + # check that old names are saved as labels when set_labels is TRUE + expect_equal(attr(dat_df_clean_labels[[i]], "label"), names(dat_df)[[i]]) + expect_equal(attr(dat_sf_clean_labels[[i]], "label"), names(dat_sf)[[i]]) + + # check that old names are not stored if set_labels is not TRUE + expect_null(attr(dat_df_clean[[i]], "label")) + expect_null(attr(dat_sf_clean[[i]], "label")) + } + + # expect names are always cleaned + expect_equal(names(dat_df_clean), c("a_a", "b_b")) + expect_equal(names(dat_df_clean_labels), c("a_a", "b_b")) + expect_equal(names(dat_sf_clean), c("a_a", "b_b", "geometry")) + expect_equal(names(dat_sf_clean_labels), c("a_a", "b_b", "geometry")) +}) + test_that("allow for duplicates (fix #495)", { expect_equal( @@ -589,7 +618,7 @@ test_that("tbl_graph/tidygraph", { tidygraph::play_erdos_renyi(10, 0.5) %>% # create nodes wi tidygraph::bind_nodes(test_df) %>% - dplyr::mutate(dplyr::across(dplyr::where(is.numeric), ~ dplyr::coalesce(x, 1))) + dplyr::mutate(dplyr::across(dplyr::where(is.numeric), \(x) dplyr::coalesce(x, 1))) # create a graph with clean names # warning due to unhandled mu