Merge branch 'f-#83-indexes'

- Strict checking of integer and logical column indexes. For integers, passing a non-integer index or an out-of-bounds index raises an error. For logicals, only vectors of length 1 or `ncol` are supported. Passing a matrix or an array now raises an error in any case (#83).

R/check-names.R

@@ -0,0 +1,57 @@
+check_names_df <- function(j, ...) UseMethod("check_names_df")
+
+check_names_df.default <- function(j, ...) {
+  stop("unsupported index type: ", class(j)[[1L]])
+}
+
+check_names_df.character <- function(j, x) {
+  check_needs_no_dim(j)
+
+  pos <- safe_match(j, names(x))
+  if(any(is.na(pos))){
+    names <- j[is.na(pos)]
+    stop("undefined columns: ", paste(names, collapse = ", "), call. = FALSE)
+  }
+  pos
+}
+
+check_names_df.numeric <- function(j, x) {
+  check_needs_no_dim(j)
+
+  if (any(is.na(j))) {
+    stop("NA column indexes not supported", call. = FALSE)
+  }
+
+  non_integer <- (j != trunc(j))
+  if (any(non_integer)) {
+    stop("invalid non-integer column indexes: ", paste(j[non_integer], collapse = ", "), call. = FALSE)
+  }
+  neg_too_small <- (j < -length(x))
+  if (any(neg_too_small)) {
+    stop("invalid negative column indexes: ", paste(j[neg_too_small], collapse = ", "), call. = FALSE)
+  }
+  pos_too_large <- (j > length(x))
+  if (any(pos_too_large)) {
+    stop("invalid column indexes: ", paste(j[pos_too_large], collapse = ", "), call. = FALSE)
+  }
+
+  seq_along(x)[j]
+}
+
+check_names_df.logical <- function(j, x) {
+  check_needs_no_dim(j)
+
+  if (!(length(j) %in% c(1L, length(x)))) {
+    stop("length of logical index vector must be 1 or ", length(x), ", got: ", length(j), call. = FALSE)
+  }
+  if (any(is.na(j))) {
+    stop("NA column indexes not supported", call. = FALSE)
+  }
+  seq_along(x)[j]
+}
+
+check_needs_no_dim <- function(j) {
+  if (needs_dim(j)) {
+    stop("unsupported use of matrix or array for column indexing", call. = FALSE)
+  }
+}

R/tbl-df.r

@@ -15,13 +15,6 @@ print.tbl_df <- function(x, ..., n = NULL, width = NULL) {
   invisible(x)
 }
 
-.check_names_df <- function(x, j){
-  if( is.character(j) && any( wrong <- ! j %in% names(x) ) ){
-    names <- j[wrong]
-    stop( sprintf( "undefined columns: %s", paste(names, collapse = ", " ) ) ) ;
-  }
-}
-
 #' @export
 `[[.tbl_df` <- function(x, i, j, ..., exact = TRUE) {
   if (missing(j))
@@ -56,7 +49,7 @@ print.tbl_df <- function(x, ..., n = NULL, width = NULL) {
   # Escape early if nargs() == 2L; ie, column subsetting
   if (nargs() <= 2L) {
     if (!missing(i)) {
-      .check_names_df(x, i)
+      i <- check_names_df(i, x)
       result <- .subset(x, i)
     } else {
       result <- x
@@ -67,7 +60,7 @@ print.tbl_df <- function(x, ..., n = NULL, width = NULL) {
 
   # First, subset columns
   if (!missing(j)) {
-    .check_names_df(x,j)
+    j <- check_names_df(j, x)
     x <- .subset(x, j)
   }
 

R/utils.r

@@ -20,9 +20,13 @@ is_vector <- function(x) {
   is_atomic(x) || is.list(x)
 }
 
+needs_dim <- function(x) {
+  length(dim(x)) > 1L
+}
+
 is_1d <- function(x) {
   # dimension check is for matrices and data.frames
-  (is_atomic(x) || is.list(x)) && length(dim(x)) <= 1
+  is_vector(x) && !needs_dim(x)
 }
 
 strip_dim <- function(x) {
@@ -34,3 +38,13 @@ strip_dim <- function(x) {
 needs_list_col <- function(x) {
   is.list(x) || length(x) != 1L
 }
+
+# Work around bug in R 3.3.0
+safe_match <- function(x, table) {
+  # nocov start
+  if (getRversion() == "3.3.0")
+    match(x, table, incomparables = character())
+  else
+    match(x, table)
+  # nocov end
+}

tests/testthat/test-tbl-df.R

@@ -38,11 +38,52 @@ test_that("[ with 0 cols creates correct row names (#656)", {
 
 test_that("[.tbl_df is careful about names (#1245)",{
   foo <- data_frame(x = 1:10, y = 1:10)
-  expect_error( foo["z"] )
-  expect_error( foo[ c("x", "y", "z") ] )
+  expect_error(foo["z"], "undefined columns")
+  expect_error(foo[ c("x", "y", "z") ], "undefined columns")
 
-  expect_error( foo[, "z"] )
-  expect_error( foo[, c("x", "y", "z") ] )
+  expect_error(foo[, "z"], "undefined columns")
+  expect_error(foo[, c("x", "y", "z") ], "undefined columns")
+
+  expect_error(foo[as.matrix("x")], "matrix")
+  expect_error(foo[array("x", dim = c(1, 1, 1))], "array")
+})
+
+test_that("[.tbl_df is careful about column indexes (#83)",{
+  foo <- data_frame(x = 1:10, y = 1:10, z = 1:10)
+  expect_identical(foo[1:3], foo)
+  expect_error(foo[0.5], "invalid non-integer column indexes: 0.5", fixed = TRUE)
+  expect_error(foo[1:5], "invalid column indexes: 4, 5", fixed = TRUE)
+  expect_error(foo[-1:1], "mixed with negative")
+  expect_error(foo[c(-1, 1)], "mixed with negative")
+  expect_error(foo[-4], "invalid negative column indexes: -4", fixed = TRUE)
+  expect_error(foo[c(1:3, NA)], "NA column indexes not supported", fixed = TRUE)
+
+  expect_error(foo[as.matrix(1)], "matrix")
+  expect_error(foo[array(1, dim = c(1, 1, 1))], "array")
+})
+
+test_that("[.tbl_df is careful about column flags (#83)",{
+  foo <- data_frame(x = 1:10, y = 1:10, z = 1:10)
+  expect_identical(foo[TRUE], foo)
+  expect_identical(foo[c(TRUE, TRUE, TRUE)], foo)
+  expect_identical(foo[FALSE], foo[integer()])
+  expect_identical(foo[c(FALSE, TRUE, FALSE)], foo[2])
+
+  expect_error(foo[c(TRUE, TRUE)], "length of logical index vector must be 1 or 3, got: 2", fixed = TRUE)
+  expect_error(foo[c(TRUE, TRUE, FALSE, FALSE)], "length of logical index vector must be 1 or 3, got: 4", fixed = TRUE)
+  expect_error(foo[c(TRUE, TRUE, NA)], "NA column indexes not supported", fixed = TRUE)
+
+  expect_error(foo[as.matrix(TRUE)], "matrix")
+  expect_error(foo[array(TRUE, dim = c(1, 1, 1))], "array")
+})
+
+test_that("[.tbl_df rejects unknown column indexes (#83)",{
+  foo <- data_frame(x = 1:10, y = 1:10, z = 1:10)
+  expect_error(foo[list(1:3)], "unsupported index type: list", fixed = TRUE)
+  expect_error(foo[as.list(1:3)], "unsupported index type: list", fixed = TRUE)
+  expect_error(foo[factor(1:3)], "unsupported index type: factor", fixed = TRUE)
+  expect_error(foo[Sys.Date()], "unsupported index type: Date", fixed = TRUE)
+  expect_error(foo[Sys.time()], "unsupported index type: POSIXct", fixed = TRUE)
 })
 
 test_that("[.tbl_df is no-op if args missing",{