Merge pull request #45 from hadley/feature/cleanup-c2r-2

- Cleanup for `column_to_rownames()` and `rownames_to_columns()` (#45).

R/dataframe.R

@@ -201,60 +201,6 @@ as_data_frame.NULL <- function(x, ...) {
   as_data_frame(list())
 }
 
-#' \code{rownames_to_column} convert row names to an explicit variable.
-#'
-#' @param var Name of variable to use
-#' @export
-#' @rdname rownames
-#' @importFrom stats setNames
-#' @examples
-#'
-#' rownames_to_column(mtcars)
-#'
-#' mtcars_tbl <- rownames_to_column(tbl_df(mtcars))
-#' mtcars_tbl
-rownames_to_column <- function(df, var = "rowname") {
-
-  stopifnot(is.data.frame(df))
-
-  if (var %in% colnames(df) ) {
-    stop(paste("There is a column named", var, "already!"))
-  }
-
-  rn <- as_data_frame(setNames(list(rownames(df)), var))
-  rownames(df) <- NULL
-
-  rn_df <- cbind(rn, df)
-  class(rn_df) <- class(df)
-  return (rn_df)
-}
-
-#' \code{column_to_rownames} convert a column variable to row names. This is an
-#' inverted operation of \code{rownames_to_column}.
-#'
-#' @rdname rownames
-#' @export
-#' @examples
-#'
-#' column_to_rownames(mtcars_tbl)
-column_to_rownames <- function(df, var = "rowname") {
-  stopifnot(is.data.frame(df))
-
-  if (!identical(rownames(df), as.character(seq_len(NROW(df))))) {
-    stop("This data frame already has row names.")
-
-  } else {
-    if ( !var %in% colnames(df) ) {
-      stop(paste0("This data frame has no column named ", var, ".") )
-    }
-
-    rownames(df) <- df[[var]]
-    df[, var] <- NULL
-    return (df)
-    }
-}
-
-
 #' Add a row to a data frame
 #'
 #' This is a convenient way to add a single row of data to an existing data

R/rownames.R

@@ -19,6 +19,58 @@ has_rownames <- function(df) {
 #' rownames(remove_rownames(mtcars))
 remove_rownames <- function(df) {
   stopifnot(is.data.frame(df))
-  attr(df, "row.names") <- .set_row_names(nrow(df))
+  rownames(df) <- NULL
+  df
+}
+
+#' \code{rownames_to_column} convert row names to an explicit variable.
+#'
+#' @param var Name of variable to use
+#' @export
+#' @rdname rownames
+#' @importFrom stats setNames
+#' @examples
+#' rownames_to_column(mtcars)
+#'
+#' mtcars_tbl <- rownames_to_column(tbl_df(mtcars))
+#' mtcars_tbl
+rownames_to_column <- function(df, var = "rowname") {
+  stopifnot(is.data.frame(df))
+
+  if (var %in% colnames(df))
+    stop("There is a column named ", var, " already!", call. = FALSE)
+
+  rn <- data_frame(rownames(df))
+  names(rn) <- var
+
+  attribs <- attributes(df)
+
+  new_df <- c(rn, df)
+  attribs[["names"]] <- names(new_df)
+
+  attributes(new_df) <- attribs[names(attribs) != "row.names"]
+  attr(new_df, "row.names") <- .set_row_names(nrow(df))
+  new_df
+}
+
+#' \code{column_to_rownames} convert a column variable to row names. This is an
+#' inverted operation of \code{rownames_to_column}.
+#'
+#' @rdname rownames
+#' @export
+#' @examples
+#'
+#' column_to_rownames(mtcars_tbl)
+column_to_rownames <- function(df, var = "rowname") {
+  stopifnot(is.data.frame(df))
+
+  if (has_rownames(df))
+    stop("This data frame already has row names.", call. = FALSE)
+
+  if (!var %in% colnames(df))
+    stop("This data frame has no column named ", var, ".", call. = FALSE)
+
+  rownames(df) <- df[[var]]
+  df[[var]] <- NULL
   df
 }

R/utils-format.r

@@ -63,7 +63,7 @@ trunc_mat <- function(x, n = NULL, width = NULL, n_extra = 100) {
 
 #' @importFrom stats setNames
 shrink_mat <- function(df, width, n_extra, var_names, var_types, rows, n) {
-  rownames(df) <- NULL
+  df <- remove_rownames(df)
 
   # Minimum width of each column is 5 "(int)", so we can make a quick first
   # pass

tests/testthat/test-data_frame.R

@@ -74,35 +74,6 @@ test_that("Zero column list makes 0 x 0 tbl_df", {
 })
 
 
-test_that("rownames_to_column keeps the tbl classes (#882)", {
-  res <- rownames_to_column( mtcars, "Make&Model" )
-  expect_equal( class(res), class(mtcars) )
-  expect_error(rownames_to_column( mtcars, "wt"),
-               paste("There is a column named wt already!")  )
-  res1 <- rownames_to_column( tbl_df(mtcars), "Make&Model" )
-  expect_equal( class(res1), class(tbl_df(mtcars)) )
-  expect_error(rownames_to_column( mtcars, "wt"),
-               paste("There is a column named wt already!")  )
-})
-
-test_that("column_to_rownames returns tbl", {
-  var <- "car"
-  mtcars <- tbl_df(mtcars)
-  res <- column_to_rownames( rownames_to_column( mtcars, var), var)
-  expect_equal( class(res), class(mtcars) )
-  expect_equal(rownames(res), rownames(mtcars))
-  expect_equal(res, mtcars)
-  expect_false(var %in% names(res))
-
-  mtcars$num <- rev(seq_len(nrow(mtcars)))
-  res1 <- column_to_rownames( rownames_to_column( mtcars), var="num")
-  expect_equal(rownames(res1), as.character(mtcars$num) )
-  expect_error(column_to_rownames(res1), "This data frame already has row names.")
-  expect_error(column_to_rownames( rownames_to_column( mtcars, var), "num2"),
-               paste("This data frame has no column named num2.")  )
-})
-
-
 test_that("NULL makes 0 x 0 tbl_df", {
   nnnull <- as_data_frame(NULL)
   expect_is(nnnull, "tbl_df")

tests/testthat/test-rownames.R

@@ -4,5 +4,38 @@ test_that("has_rownames and remove_rownames", {
   expect_false(has_rownames(iris))
   expect_true(has_rownames(mtcars))
   expect_false(has_rownames(remove_rownames(mtcars)))
+  expect_false(has_rownames(remove_rownames(iris)))
   expect_error(has_rownames(1:10))
 })
+
+test_that("rownames_to_column keeps the tbl classes (#882)", {
+  res <- rownames_to_column( mtcars, "Make&Model" )
+  expect_false(has_rownames(res))
+  expect_equal( class(res), class(mtcars) )
+  expect_error(rownames_to_column( mtcars, "wt"),
+               paste("There is a column named wt already!")  )
+  res1 <- rownames_to_column( tbl_df(mtcars), "Make&Model" )
+  expect_false(has_rownames(res1))
+  expect_equal( class(res1), class(tbl_df(mtcars)) )
+  expect_error(rownames_to_column( mtcars, "wt"),
+               paste("There is a column named wt already!")  )
+})
+
+test_that("column_to_rownames returns tbl", {
+  var <- "car"
+  mtcars <- tbl_df(mtcars)
+  res <- column_to_rownames( rownames_to_column( mtcars, var), var)
+  expect_true(has_rownames(res))
+  expect_equal( class(res), class(mtcars) )
+  expect_equal(rownames(res), rownames(mtcars))
+  expect_equal(res, mtcars)
+  expect_false(var %in% names(res))
+
+  mtcars$num <- rev(seq_len(nrow(mtcars)))
+  res1 <- column_to_rownames( rownames_to_column( mtcars), var="num")
+  expect_true(has_rownames(res1))
+  expect_equal(rownames(res1), as.character(mtcars$num) )
+  expect_error(column_to_rownames(res1), "This data frame already has row names.")
+  expect_error(column_to_rownames( rownames_to_column( mtcars, var), "num2"),
+               paste("This data frame has no column named num2.")  )
+})