From b71090f9280f01055a130836d68e9e0a0d3eeeb2 Mon Sep 17 00:00:00 2001 From: Will Beasley Date: Tue, 31 Mar 2015 11:32:00 -0500 Subject: [PATCH] warns if duplicates in rename Related to #127 and #194 --- R/rename.r | 15 ++++++-- man/rename.Rd | 7 ++-- tests/testthat/test-rename.r | 70 +++++++++++++++++++++++++++++++++++- 3 files changed, 87 insertions(+), 5 deletions(-) diff --git a/R/rename.r b/R/rename.r index a2005389..eaa6d8d6 100644 --- a/R/rename.r +++ b/R/rename.r @@ -5,6 +5,8 @@ #' old names as names. #' @param warn_missing print a message if any of the old names are #' not actually present in \code{x}. +#' @param warn_duplicate print a message if any name appears more +#' than once in \code{x} after the operation. #' Note: x is not altered: To save the result, you need to copy the returned #' data into a variable. #' @export @@ -16,7 +18,16 @@ #' x #' # Rename column "disp" to "displacement" #' rename(mtcars, c("disp" = "displacement")) -rename <- function(x, replace, warn_missing = TRUE) { +rename <- function(x, replace, warn_missing = TRUE, warn_duplicate = TRUE ) { + + # This line does the real work of `rename()`. names(x) <- revalue(names(x), replace, warn_missing = warn_missing) - x + + # Check if any names are duplicated. + duplicated_names <- names(x)[duplicated(names(x))] + if( warn_duplicate && (length(duplicated_names) > 0L) ) { + response_message <- paste0("The plyr::rename operation has created duplicates for the following name(s): (`", paste(duplicated_names, collapse="`, `"), "`)") + warning(response_message) + } + return( x ) } diff --git a/man/rename.Rd b/man/rename.Rd index e2fe4301..d33bf7ce 100644 --- a/man/rename.Rd +++ b/man/rename.Rd @@ -4,7 +4,7 @@ \alias{rename} \title{Modify names by name, not position.} \usage{ -rename(x, replace, warn_missing = TRUE) +rename(x, replace, warn_missing = TRUE, warn_duplicate = TRUE) } \arguments{ \item{x}{named object to modify} @@ -13,7 +13,10 @@ rename(x, replace, warn_missing = TRUE) old names as names.} \item{warn_missing}{print a message if any of the old names are - not actually present in \code{x}. +not actually present in \code{x}.} + +\item{warn_duplicate}{print a message if any name appears more + than once in \code{x} after the operation. Note: x is not altered: To save the result, you need to copy the returned data into a variable.} } diff --git a/tests/testthat/test-rename.r b/tests/testthat/test-rename.r index 89a5047d..3f7282b5 100644 --- a/tests/testthat/test-rename.r +++ b/tests/testthat/test-rename.r @@ -1,4 +1,7 @@ -context("Rename") +################################################# +### Main-stream cases +################################################# +context("Rename - Expected Usage") test_that("No match leaves names unchanged", { x <- c(a = 1, b = 2, c = 3, 4) @@ -37,3 +40,68 @@ test_that("Renaming lists", { y <- rename(x, c("c" = "f", "b" = "e", "a" = "d")) expect_identical(y, list(d = 1, e = 2, f = 3)) }) + +################################################# +### Duplicate Names +################################################# +context("Rename - Duplicates") + +## +## This batch tests the typical renaming scenarios +## +test_that("Renaming list with an conflicting variable name - default", { + x <- list(a = 1, b = 2, c = 3) + replace_list <- c("c" = "f", "b" = "e", "a" = "f") + expected_response <- "The plyr::rename operation has created duplicates for the following name\\(s\\): \\(`f`\\)" + expect_warning(object = rename(x=x, replace=replace_list), regexp=expected_response) +}) +test_that("Renaming list with an conflicting variable name - warning", { + duplicate_behavior <- "warning" + x <- list(a = 1, b = 2, c = 3) + replace_list <- c("c" = "f", "b" = "e", "a" = "f") + expected_response <- "The plyr::rename operation has created duplicates for the following name\\(s\\): \\(`f`\\)" + result <- rename(x=x, replace=replace_list, warn_duplicate = FALSE) +}) + + +## +## This batch tests the boundary cases +## +test_that("Renaming to the same value", { + #One element is renamed to itself + x <- list(a = 1, b = 2, c = 3) + replace_list <- c("a" = "a") + expected_value <- x + expect_identical(rename(x=x, replace=replace_list), expected=expected_value) +}) +test_that("Renaming list with an empty renaming vector", { + #No renames are requested (which could happen if the calling code was under a lot of automated code.) + x <- list(a = 1, b = 2, c = 3) + replace_list <- c() + expected_value <- x + expect_identical(rename(x=x, replace=replace_list), expected=expected_value) +}) +test_that("Single Swapping (shouldn't cause problems)", { + #Notice how a becomes c, while c becomes f. + x <- list(a = 1, b = 2, c = 3) + replace_list <- c("c" = "f", "b" = "e", "a" = "c") + expected_value <- list(c = 1, e = 2, f = 3) + actual_value <- rename(x=x, replace=replace_list) + expect_identical(actual_value, expected=expected_value) +}) +test_that("Double Swapping (shouldn't cause problems)", { + #Notice how a becomes c, while c becomes a. + x <- list(a = 1, b = 2, c = 3) + replace_list <- c("c" = "a", "b" = "z", "a" = "c") + expected_value <- list(c = 1, z = 2, a = 3) + actual_value <- rename(x=x, replace=replace_list) + expect_identical(actual_value, expected=expected_value) +}) +test_that("Multiple assignments for the same element", { + #Notice how it requests to change a to d, e, and f. + x <- list(a = 1, b = 2, c = 3) + replace_list <- c("a" = "d", "a" = "e", "a" = "f") + expected_response <- "The following `from` values were not present in `x`: a, a" + expected_value <- list(a = 1, a = 2, a = 3) + expect_message(rename(x=x, replace=replace_list), regexp=expected_response) +})