warns if duplicates in rename

Related to hadley#127 and hadley#194

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 )
 }

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.}
 }

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)
+})