From cab7b775e2d49edb04981c913d16ddb23e97cc20 Mon Sep 17 00:00:00 2001 From: etiennebacher Date: Thu, 28 Nov 2024 14:37:26 +0100 Subject: [PATCH] init --- DESCRIPTION | 2 +- NEWS.md | 9 +++-- R/data_rename.R | 63 +++++++++++++++++-------------- tests/testthat/test-attributes.R | 2 +- tests/testthat/test-data_rename.R | 40 ++++++++++++-------- 5 files changed, 67 insertions(+), 49 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b75f96278..588bfd4eb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: datawizard Title: Easy Data Wrangling and Statistical Transformations -Version: 0.13.0.15 +Version: 0.13.0.16 Authors@R: c( person("Indrajeet", "Patil", , "patilindrajeet.science@gmail.com", role = "aut", comment = c(ORCID = "0000-0003-1995-6531")), diff --git a/NEWS.md b/NEWS.md index a701ba2b8..29c2f642c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,12 @@ # datawizard (development) -BREAKING CHANGES +DEPRECATIONS + +* Argument `drop_na` in `data_match()` is deprecated now. Please use + `remove_na` instead. -* Argument `drop_na` in `data_match()` is deprecated now. Please use `remove_na` - instead. +* Argument `pattern` in `data_rename()` is deprecated. Please use `select` + instead (#567). CHANGES diff --git a/R/data_rename.R b/R/data_rename.R index f5d6e0e03..edde427e9 100644 --- a/R/data_rename.R +++ b/R/data_rename.R @@ -10,7 +10,7 @@ #' pipe-workflow. #' #' @param data A data frame, or an object that can be coerced to a data frame. -#' @param pattern Character vector. +#' @param select Character vector. #' - For `data_addprefix()` or `data_addsuffix()`, a character string, which #' will be added as prefix or suffix to the column names. #' - For `data_rename()`, indicates columns that should be selected for @@ -51,6 +51,7 @@ #' @param safe Do not throw error if for instance the variable to be #' renamed/removed doesn't exist. #' @param verbose Toggle warnings and messages. +#' @param pattern Deprecated. Use `select` instead. #' @param ... Other arguments passed to or from other functions. #' #' @return A modified data frame. @@ -96,28 +97,34 @@ #' #' @export data_rename <- function(data, - pattern = NULL, + select = NULL, replacement = NULL, safe = TRUE, verbose = TRUE, + pattern = NULL, ...) { + if (!is.null(pattern)) { + .is_deprecated("pattern", "select") + select <- pattern + } + # change all names if no pattern specified - if (is.null(pattern)) { - pattern <- names(data) + if (is.null(select)) { + select <- names(data) } - if (!is.character(pattern)) { - insight::format_error("Argument `pattern` must be of type character.") + if (!is.character(select)) { + insight::format_error("Argument `select` must be of type character.") } - # check if `pattern` has names, and if so, use as "replacement" - if (!is.null(names(pattern))) { - replacement <- names(pattern) + # check if `select` has names, and if so, use as "replacement" + if (!is.null(names(select))) { + replacement <- names(select) } # name columns 1, 2, 3 etc. if no replacement if (is.null(replacement)) { - replacement <- paste0(seq_along(pattern)) + replacement <- paste0(seq_along(select)) } # coerce to character @@ -126,22 +133,22 @@ data_rename <- function(data, # check if `replacement` has no empty strings and no NA values invalid_replacement <- is.na(replacement) | !nzchar(replacement) if (any(invalid_replacement)) { - if (is.null(names(pattern))) { - # when user did not match `pattern` with `replacement` + if (is.null(names(select))) { + # when user did not match `select` with `replacement` msg <- c( "`replacement` is not allowed to have `NA` or empty strings.", sprintf( - "Following values in `pattern` have no match in `replacement`: %s", - toString(pattern[invalid_replacement]) + "Following values in `select` have no match in `replacement`: %s", + toString(select[invalid_replacement]) ) ) } else { - # when user did not name all elements of `pattern` + # when user did not name all elements of `select` msg <- c( - "Either name all elements of `pattern` or use `replacement`.", + "Either name all elements of `select` or use `replacement`.", sprintf( - "Following values in `pattern` were not named: %s", - toString(pattern[invalid_replacement]) + "Following values in `select` were not named: %s", + toString(select[invalid_replacement]) ) ) } @@ -163,30 +170,30 @@ data_rename <- function(data, # check if we have "glue" styled replacement-string glue_style <- length(replacement) == 1 && grepl("{", replacement, fixed = TRUE) - if (length(replacement) > length(pattern) && verbose) { + if (length(replacement) > length(select) && verbose) { insight::format_alert( paste0( - "There are more names in `replacement` than in `pattern`. The last ", - length(replacement) - length(pattern), " names of `replacement` are not used." + "There are more names in `replacement` than in `select`. The last ", + length(replacement) - length(select), " names of `replacement` are not used." ) ) - } else if (length(replacement) < length(pattern) && verbose && !glue_style) { + } else if (length(replacement) < length(select) && verbose && !glue_style) { insight::format_alert( paste0( - "There are more names in `pattern` than in `replacement`. The last ", - length(pattern) - length(replacement), " names of `pattern` are not modified." + "There are more names in `select` than in `replacement`. The last ", + length(select) - length(replacement), " names of `select` are not modified." ) ) } - # if we have glue-styled replacement-string, create replacement pattern now + # if we have glue-styled replacement-string, create replacement select now if (glue_style) { - replacement <- .glue_replacement(pattern, replacement) + replacement <- .glue_replacement(select, replacement) } - for (i in seq_along(pattern)) { + for (i in seq_along(select)) { if (!is.na(replacement[i])) { - data <- .data_rename(data, pattern[i], replacement[i], safe, verbose) + data <- .data_rename(data, select[i], replacement[i], safe, verbose) } } diff --git a/tests/testthat/test-attributes.R b/tests/testthat/test-attributes.R index ebd26de99..df1ec0302 100644 --- a/tests/testthat/test-attributes.R +++ b/tests/testthat/test-attributes.R @@ -136,7 +136,7 @@ test_that("convert_to_na, attributes preserved", { test_that("data_rename, attributes preserved", { x <- mtcars attr(x, "myattri") <- "I'm here" - x2 <- data_rename(x, pattern = "hp", replacement = "horsepower") + x2 <- data_rename(x, select = "hp", replacement = "horsepower") expect_identical(attr(x2, "myattri", exact = TRUE), "I'm here") }) diff --git a/tests/testthat/test-data_rename.R b/tests/testthat/test-data_rename.R index 79f4427b3..723fef30f 100644 --- a/tests/testthat/test-data_rename.R +++ b/tests/testthat/test-data_rename.R @@ -25,26 +25,26 @@ test_that("data_rename returns a data frame", { expect_s3_class(x, "data.frame") }) -test_that("data_rename: pattern must be of type character", { +test_that("data_rename: select must be of type character", { expect_error( - data_rename(test, pattern = 1), - regexp = "Argument `pattern` must be of type character" + data_rename(test, select = 1), + regexp = "Argument `select` must be of type character" ) expect_error( - data_rename(test, pattern = TRUE), - regexp = "Argument `pattern` must be of type character" + data_rename(test, select = TRUE), + regexp = "Argument `select` must be of type character" ) }) test_that("data_rename: replacement not allowed to have NA or empty strings", { expect_error( - data_rename(test, pattern = c(test = "Species", "Sepal.Length")), - regexp = "Either name all elements of `pattern`" + data_rename(test, select = c(test = "Species", "Sepal.Length")), + regexp = "Either name all elements of `select`" ) expect_error( data_rename( test, - pattern = c("Species", "Sepal.Length"), + select = c("Species", "Sepal.Length"), replacement = c("foo", NA_character_) ), regexp = "`replacement` is not allowed" @@ -54,7 +54,7 @@ test_that("data_rename: replacement not allowed to have NA or empty strings", { # replacement ------------- test_that("data_rename uses indices when no replacement", { - x <- data_rename(test, pattern = c("Sepal.Length", "Petal.Length")) + x <- data_rename(test, select = c("Sepal.Length", "Petal.Length")) expect_identical(dim(test), dim(x)) expect_named(x, c("1", "Sepal.Width", "2", "Petal.Width", "Species")) }) @@ -82,16 +82,16 @@ test_that("data_rename works when not enough names in 'replacement'", { }) -# no pattern -------------- +# no select -------------- -test_that("data_rename uses the whole dataset when pattern = NULL", { +test_that("data_rename uses the whole dataset when select = NULL", { x1 <- data_rename(test) - x2 <- data_rename(test, pattern = names(test)) + x2 <- data_rename(test, select = names(test)) expect_identical(dim(test), dim(x1)) expect_identical(x1, x2) x3 <- data_rename(test, replacement = paste0("foo", 1:5)) - x4 <- data_rename(test, pattern = names(test), replacement = paste0("foo", 1:5)) + x4 <- data_rename(test, select = names(test), replacement = paste0("foo", 1:5)) expect_identical(dim(test), dim(x3)) expect_identical(x3, x4) }) @@ -112,14 +112,14 @@ test_that("data_rename: argument 'safe' works", { test_that("data_rename deals correctly with duplicated replacement", { x <- data_rename(test, - pattern = names(test)[1:4], + select = names(test)[1:4], replacement = c("foo", "bar", "foo", "bar") ) expect_identical(dim(test), dim(x)) expect_named(x[1:4], c("foo", "bar", "foo.2", "bar.2")) }) -test_that("data_rename doesn't change colname if invalid pattern", { +test_that("data_rename doesn't change colname if invalid select", { x <- suppressMessages(data_rename(test, "FakeCol", "length")) expect_named(x, names(test)) }) @@ -142,7 +142,7 @@ test_that("data_rename preserves attributes", { }) -# glue-styled pattern -------------------------- +# glue-styled select -------------------------- test_that("data_rename glue-style", { data(mtcars) @@ -226,3 +226,11 @@ withr::with_environment( ) }) ) + +test_that("Argument `pattern` is deprecated", { + expect_warning( + head(data_rename(iris, pattern = "Sepal.Length", "length")), + "Argument `pattern` is deprecated. Please use `select` instead.", + fixed = TRUE + ) +})