Merge pull request #72 from hadley/feature/star-rownames

- Indicate presence of row names by a star in printed output (#72).
- Warn if setting non-`NULL` row names (#75).
- `has_rownames()` supports arguments that are not data frames.

NAMESPACE

@@ -3,6 +3,7 @@
 S3method("$",tbl_df)
 S3method("[",tbl_df)
 S3method("[[",tbl_df)
+S3method("row.names<-",tbl_df)
 S3method(all.equal,tbl_df)
 S3method(as.data.frame,tbl_df)
 S3method(as_data_frame,"NULL")

R/all-equal.r

@@ -52,7 +52,10 @@ all_equal <- function(target, current, ignore_col_order = TRUE,
     return("Column names same but in different order")
   }
 
-  current <- `rownames<-`(current[names(target)], rownames(current))
+  current <- as_data_frame(remove_rownames(current))
+  target <- as_data_frame(remove_rownames(target))
+
+  current <- current[names(target)]
 
   types <- unlist(mapply(
     function(x, y) {

R/rownames.R

@@ -2,13 +2,18 @@
 #'
 #' While a tibble can have row names (e.g., when converting from a regular data
 #' frame), they are removed when subsetting with the \code{[} operator.
+#' A warning will be raised when attempting to assign non-\code{NULL} row names
+#' to a tibble.
 #' Generally, it is best to avoid row names, because they are basically a
 #' character column with different semantics to every other column. These
 #' functions allow to you detect if a data frame has row names
 #' (\code{has_rownames}), remove them (\code{remove_rownames}), or convert
-#' them back-and-forth between an explicit column (\code{rownames_to_column},
+#' them back-and-forth between an explicit column (\code{rownames_to_column}
 #' and \code{column_to_rownames}).
 #'
+#' In the printed output, the presence of row names is indicated by a star just
+#' above the row numbers.
+#'
 #' @param df A data frame
 #' @param var Name of column to use for rownames.
 #' @examples
@@ -18,17 +23,16 @@
 #'
 #' head(rownames_to_column(mtcars))
 #'
-#' mtcars_tbl <- rownames_to_column(as_data_frame(mtcars))
+#' mtcars_tbl <- as_data_frame(rownames_to_column(mtcars))
 #' mtcars_tbl
-#' column_to_rownames(mtcars_tbl)
+#' column_to_rownames(as.data.frame(mtcars_tbl))
 #' @name rownames
 NULL
 
 
 #' @export
 #' @rdname rownames
 has_rownames <- function(df) {
-  stopifnot(is.data.frame(df))
   .row_names_info(df) > 0L
 }
 
@@ -76,3 +80,11 @@ column_to_rownames <- function(df, var = "rowname") {
   df[[var]] <- NULL
   df
 }
+
+#' @export
+`row.names<-.tbl_df` <- function(x, value) {
+  if (!is.null(value)) {
+    warning("Setting row names on a tibble is deprecated.", call. = FALSE)
+  }
+  NextMethod()
+}

R/utils-format.r

@@ -53,14 +53,15 @@ trunc_mat <- function(x, n = NULL, width = NULL, n_extra = NULL) {
   if (ncol(df) == 0 || nrow(df) == 0) {
     shrunk <- list(table = NULL, extra = setNames(var_types, var_names))
   } else {
-    shrunk <- shrink_mat(df, width, n_extra, var_names, var_types, rows, n)
+    shrunk <- shrink_mat(df, width, n_extra, var_names, var_types, rows, n,
+                         has_rownames(x))
   }
 
   return(structure(c(shrunk, list(width = width)), class = "trunc_mat"))
 }
 
 #' @importFrom stats setNames
-shrink_mat <- function(df, width, n_extra, var_names, var_types, rows, n) {
+shrink_mat <- function(df, width, n_extra, var_names, var_types, rows, n, star) {
   df <- remove_rownames(df)
 
   # Minimum width of each column is 5 "(int)", so we can make a quick first
@@ -106,6 +107,8 @@ shrink_mat <- function(df, width, n_extra, var_names, var_types, rows, n) {
   }
   shrunk <- format(df[, !too_wide, drop = FALSE])
   shrunk <- rbind(" " = classes, shrunk)
+  if (star)
+    rownames(shrunk)[[1]] <- "*"
   colnames(shrunk) <- colnames(df)[!too_wide]
 
   needs_dots <- is.na(rows) || rows > n

tests/testthat/output/trunc_mat/mtcars-8-30.txt

@@ -1,7 +1,7 @@
 Source: local data frame [32 x 11]
 
      mpg   cyl  disp    hp
-   <dbl> <dbl> <dbl> <dbl>
+*  <dbl> <dbl> <dbl> <dbl>
 1   21.0     6 160.0   110
 2   21.0     6 160.0   110
 3   22.8     4 108.0    93

tests/testthat/test-rownames.R

@@ -5,7 +5,12 @@ test_that("has_rownames and remove_rownames", {
   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))
+  expect_false(has_rownames(1:10))
+})
+
+test_that("setting row names on a tibble raises a warning", {
+  mtcars_tbl <- as_data_frame(mtcars)
+  expect_warning(rownames(mtcars_tbl) <- rownames(mtcars), "deprecated")
 })
 
 test_that("rownames_to_column keeps the tbl classes (#882)", {
@@ -23,21 +28,24 @@ test_that("rownames_to_column keeps the tbl classes (#882)", {
 
 test_that("column_to_rownames returns tbl", {
   var <- "car"
-  mtcars <- as_data_frame(mtcars)
-  res <- column_to_rownames( rownames_to_column( mtcars, var), var)
+  mtcars1 <- as_data_frame(mtcars)
+  expect_true(has_rownames(mtcars1))
+  res0 <- rownames_to_column(mtcars1, var)
+  expect_warning(res <- column_to_rownames(res0, var))
   expect_true(has_rownames(res))
-  expect_equal( class(res), class(mtcars) )
-  expect_equal(rownames(res), rownames(mtcars))
-  expect_equal(res, mtcars)
+  expect_equal(class(res), class(mtcars1))
+  expect_equal(rownames(res), rownames(mtcars1))
+  expect_equal(res, mtcars1)
   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.")  )
+  mtcars1$num <- rev(seq_len(nrow(mtcars)))
+  res0 <- rownames_to_column(mtcars1)
+  expect_warning(res <- column_to_rownames(res0, var = "num"))
+  expect_true(has_rownames(res))
+  expect_equal(rownames(res), as.character(mtcars1$num))
+  expect_error(column_to_rownames(res), "This data frame already has row names.")
+  expect_error(column_to_rownames(rownames_to_column(mtcars1, var), "num2"),
+               paste("This data frame has no column named num2."))
 })
 
 test_that("converting to data frame does not add row names", {