Merge pull request #416 from DavisVaughan/shape

Use 0-size tidyverse recycling rules consistently

R/recycle.R

@@ -10,6 +10,8 @@
 #' The common size of two vectors defines the recycling rules, and can be
 #' summarise with the following table:
 #'
+#' \figure{sizes-recycling.png}
+#'
 #' (Note `NULL`s are handled specially; they are treated like empty
 #' arguments and hence don't affect the size)
 #'
@@ -27,13 +29,11 @@
 #' @examples
 #' # Inputs with 1 observation are recycled
 #' vec_recycle_common(1:5, 5)
+#' vec_recycle_common(integer(), 5)
 #' \dontrun{
 #' vec_recycle_common(1:5, 1:2)
 #' }
 #'
-#' # Inputs with 0 observations
-#' vec_recycle_common(1:5, integer())
-#'
 #' # Data frames and matrices are recycled along their rows
 #' vec_recycle_common(data.frame(x = 1), 1:5)
 #' vec_recycle_common(array(1:2, c(1, 2)), 1:5)

R/shape.R

@@ -18,7 +18,19 @@ shape_match <- function(type, x, y) {
 
 shape_common <- function(x, y) {
   shape <- n_dim2(shape(x), shape(y))
-  map2_int(shape$x, shape$y, vec_size2)
+  map2_int(shape$x, shape$y, axis2)
+}
+
+axis2 <- function(nx, ny) {
+  if (nx == ny) {
+    nx
+  } else if (nx == 1L) {
+    ny
+  } else if (ny == 1L) {
+    nx
+  } else {
+    abort(paste0("Incompatible lengths: ", nx, ", ", ny, "."))
+  }
 }
 
 shape_broadcast <- function(x, to) {
@@ -40,7 +52,7 @@ shape_broadcast <- function(x, to) {
 
   dim_x <- n_dim2(dim_x, dim_to)$x
   dim_to[[1]] <- dim_x[[1]] # don't change number of observations
-  ok <- dim_x == dim_to | dim_x == 1 | dim_to == 0
+  ok <- dim_x == dim_to | dim_x == 1
   if (any(!ok)) {
     stop_incompatible_cast(x, to, details = "Non-recyclable dimensions")
   }

R/size.R

@@ -66,7 +66,7 @@
 #'
 #' vec_size_common(1:10, 1:10)
 #' vec_size_common(1:10, 1)
-#' vec_size_common(1:10, integer())
+#' vec_size_common(integer(), 1)
 vec_size <- function(x) {
   .Call(vctrs_size, x)
 }
@@ -77,21 +77,6 @@ vec_size_common <- function(..., .size = NULL, .absent = 0L) {
   .External2(vctrs_size_common, .size, .absent)
 }
 
-vec_size2 <- function(nx, ny) {
-  if (nx == ny) {
-    nx
-  } else if (nx == 0L || ny == 0L) {
-    0L
-  } else if (nx == 1L) {
-    ny
-  } else if (ny == 1L) {
-    nx
-  } else {
-    abort(paste0("Incompatible lengths: ", nx, ", ", ny, "."))
-  }
-}
-
-
 #' @rdname vec_size
 #' @export
 vec_is_empty <- function(x) {

src/size-common.c

@@ -68,13 +68,6 @@ static SEXP vctrs_size2_common(SEXP x, SEXP y, struct counters* counters) {
   if (nx == ny) {
     return x;
   }
-  if (nx == 0) {
-    return x;
-  }
-  if (ny == 0) {
-    counters_shift(counters);
-    return y;
-  }
   if (nx == 1) {
     counters_shift(counters);
     return y;

src/size.c

@@ -169,10 +169,6 @@ SEXP vec_recycle(SEXP x, R_len_t size) {
     return x;
   }
 
-  if (size == 0L) {
-    return vec_slice(x, R_NilValue);
-  }
-
   if (n_x == 1L) {
     // FIXME: Replace with ALTREP repetition
     SEXP i = PROTECT(Rf_allocVector(INTSXP, size));

tests/testthat/test-recycle.R

@@ -1,4 +1,26 @@
-context("test-vec_recycle_common")
+context("test-recycle")
+
+# vec_recycle -------------------------------------------------------------
+
+test_that("vec_recycle recycles size 1 to any other size", {
+  x <- 1
+  x0 <- numeric()
+  x2 <- c(x, x)
+
+  expect_equal(vec_recycle(x, 1), x)
+  expect_equal(vec_recycle(x, 0), x0)
+  expect_equal(vec_recycle(x, 2), x2)
+})
+
+test_that("incompatible lengths get error messages", {
+  x2 <- c(1, 2)
+
+  expect_error(vec_recycle(x2, 1), "2, 1")
+  expect_error(vec_recycle(x2, 0), "2, 0")
+  expect_error(vec_recycle(x2, 3), "2, 3")
+})
+
+# Empty -------------------------------------------------------------------
 
 test_that("empty input returns empty list", {
   expect_equal(vec_recycle_common(), list())
@@ -20,68 +42,84 @@ test_that("equal lengths returned as is", {
   expect_equal(vec_recycle_common(x[0], x[0]), list(x[0], x[0]))
 })
 
-test_that("length 1 vec_recycle_commond to length of longest", {
+test_that("vec_recycle_common recycles size 1 to any other size", {
   x1 <- 1
   x3 <- rep(1, 3)
+  x0 <- numeric()
 
   expect_equal(vec_recycle_common(x1, x3), list(x3, x3))
   expect_equal(vec_recycle_common(x3, x1), list(x3, x3))
-})
-
-test_that("length 0 causes both outputs to be zero", {
-  x <- 1:3
-
-  expect_equal(vec_recycle_common(x, x[0]), list(x[0], x[0]))
-  expect_equal(vec_recycle_common(x[0], x), list(x[0], x[0]))
+  expect_equal(vec_recycle_common(x1, x0), list(x0, x0))
 })
 
 test_that("incompatible lengths get error messages", {
   expect_error(vec_recycle_common(1:2, 1:3), class = "vctrs_error_incompatible_size")
   expect_error(vec_recycle_common(1:3, 1:2), class = "vctrs_error_incompatible_size")
+  expect_error(vec_recycle_common(numeric(), 1:2), class = "vctrs_error_incompatible_size")
 })
 
 # Matrices ----------------------------------------------------------------
 
 test_that("can vec_recycle_common matrices", {
   x <- matrix(nrow = 4, ncol = 4)
   x1 <- x[1, , drop = FALSE]
-  x0 <- x[0, , drop = FALSE]
 
   expect_equal(vec_recycle_common(x, x), list(x, x))
   expect_equal(vec_recycle_common(x1, x), list(x, x))
-  expect_equal(vec_recycle_common(x0, x), list(x0, x0))
+})
+
+test_that("recycling matrices respects incompatible sizes", {
+  x <- matrix(nrow = 4, ncol = 4)
+  x2 <- x[1:2, , drop = FALSE]
+  x0 <- x[0, , drop = FALSE]
+
+  expect_error(vec_recycle_common(x2, x), class = "vctrs_error_incompatible_size")
+  expect_error(vec_recycle_common(x0, x), class = "vctrs_error_incompatible_size")
 })
 
 test_that("can vec_recycle_common data frames", {
   x <- data.frame(a = rep(1, 3), b = rep(2, 3))
   x1 <- vec_slice(x, 1L)
-  x0 <- vec_slice(x, integer())
 
   expect_equal(vec_recycle_common(x, x), list(x, x))
   expect_equal(vec_recycle_common(x1, x), list(x, x))
-  expect_equal(vec_recycle_common(x0, x), list(x0, x0))
+})
+
+test_that("recycling data frames respects incompatible sizes", {
+  x <- data.frame(a = rep(1, 3), b = rep(2, 3))
+  x2 <- vec_slice(x, 1:2)
+  x0 <- vec_slice(x, integer())
+
+  expect_error(vec_recycle_common(x2, x), class = "vctrs_error_incompatible_size")
+  expect_error(vec_recycle_common(x0, x), class = "vctrs_error_incompatible_size")
 })
 
 test_that("can vec_recycle_common matrix and data frame", {
   mt <- matrix(nrow = 2, ncol = 2)
   df <- data.frame(x = c(1, 1), y = c(2, 2))
 
-  expect_equal(
-    vec_recycle_common(vec_slice(mt, integer()), df),
-    list(vec_slice(mt, 0L), vec_slice(df, 0L))
-  )
   expect_equal(
     vec_recycle_common(vec_slice(mt, 1L), df),
     list(mt, df)
   )
 
-  expect_equal(
-    vec_recycle_common(mt, vec_slice(df, 0L)),
-    list(vec_slice(mt, 0L), vec_slice(df, 0L))
-  )
-
   expect_equal(
     vec_recycle_common(mt, vec_slice(df, 1L)),
     list(mt, df)
   )
 })
+
+test_that("recycling data frames with matrices respects incompatible sizes", {
+  mt <- matrix(nrow = 2, ncol = 2)
+  df <- data.frame(x = c(1, 1), y = c(2, 2))
+
+  expect_error(
+    vec_recycle_common(vec_slice(mt, integer()), df),
+    class = "vctrs_error_incompatible_size"
+  )
+
+  expect_error(
+    vec_recycle_common(mt, vec_slice(df, 0L)),
+    class = "vctrs_error_incompatible_size"
+  )
+})

tests/testthat/test-shape.R

@@ -17,6 +17,7 @@ test_that("length is ignored", {
   expect_equal(shape_common(int(5, 1), int(10, 1)), 1L)
   expect_equal(shape_common(int(5, 1, 2), int(10, 1, 2)), c(1L, 2L))
   expect_equal(shape_common(int(10, 1, 2), int(5, 1, 2)), c(1L, 2L))
+  expect_equal(shape_common(int(0, 1, 5), int(1, 5, 1)), c(5L, 5L))
 })
 
 test_that("recycling rules applied", {
@@ -29,8 +30,9 @@ test_that("recycling rules applied", {
   expect_equal(shape_common(int(1, 5, 1), int(1, 1, 5)), c(5L, 5L))
   expect_equal(shape_common(int(1, 1, 1), int(1, 5, 5)), c(5L, 5L))
 
-  expect_equal(shape_common(int(1, 0, 5), int(1, 5, 1)), c(0L, 5L))
-  expect_equal(shape_common(int(1, 5, 0), int(1, 1, 5)), c(5L, 0L))
+  expect_equal(shape_common(int(1, 0, 5), int(1, 1, 1)), c(0L, 5L))
+  expect_error(shape_common(int(1, 0, 5), int(1, 5, 1)), "0, 5")
+  expect_error(shape_common(int(1, 5, 0), int(1, 1, 5)), "0, 5")
 })
 
 # broadcasting -------------------------------------------------------------
@@ -53,7 +55,7 @@ test_that("can broadcast to higher dimension, but not lower", {
   )
 })
 
-test_that("recyling rules applied", {
+test_that("recycling rules applied", {
   expect_equal(
     shape_broadcast(array(1:4, c(1, 1, 4)), int(0, 4, 4))[1, , ],
     matrix(1:4, 4, 4, byrow = TRUE)
@@ -63,6 +65,23 @@ test_that("recyling rules applied", {
     shape_broadcast(array(1:4, c(1, 4, 1)), int(0, 4, 4))[1, , ],
     matrix(1:4, 4, 4)
   )
+
+  expect_equal(
+    shape_broadcast(array(1L, c(1, 1)), int(1, 0)),
+    matrix(integer(), nrow = 1)
+  )
+
+  expect_error(
+    shape_broadcast(array(1L, c(1, 2)), int(1, 0)),
+    "Non-recyclable dimensions",
+    class = "vctrs_error_incompatible_cast"
+  )
+
+  expect_error(
+    shape_broadcast(array(1L, c(1, 0)), int(1, 1)),
+    "Non-recyclable dimensions",
+    class = "vctrs_error_incompatible_cast"
+  )
 })
 
 test_that("shape of vector not supported", {

tests/testthat/test-size.R

@@ -66,9 +66,15 @@ test_that("`NULL` is treated as the absence of input", {
   expect_equal(vec_size_common(1:5, NULL), vec_size_common(1:5))
 })
 
-test_that("length 0 vectors force a common size of 0", {
-  expect_equal(vec_size_common(integer()), 0)
-  expect_equal(vec_size_common(1:5, integer()), 0)
+test_that("size 1 is overshadowed by any other size", {
+  expect_equal(vec_size_common(1, integer()), 0)
+  expect_equal(vec_size_common(1, 1:5), 5)
+})
+
+test_that("if not size 1, sizes must be identical", {
+  expect_equal(vec_size_common(integer(), integer()), 0)
+  expect_error(vec_size_common(1:2, integer()), class = "vctrs_error_incompatible_size")
+  expect_error(vec_size_common(1:2, 1:3), class = "vctrs_error_incompatible_size")
 })
 
 test_that("argument tags are forwarded", {

vignettes/type-size.Rmd

@@ -323,15 +323,10 @@ Closely related to the definition of size are the __recycling rules__. The recyc
 ```{r}
 vec_size_common(1:3, 1:3, 1:3)
 vec_size_common(1:10, 1)
-vec_size_common(integer(), 1:3)
+vec_size_common(integer(), 1)
 ```
 
-vctrs obeys a stricter set of recycling rules than base R, only recycling under two circumstances:
-
-* Vectors of size 1 can be recycled to any size.
-* Vectors of any size can be recycled to size 0.
-
-All other size combinations will generate an error. This strictness prevents common mistakes like `dest == c("IAH", "HOU"))`, at the cost of occasionally requiring an explicit calls to `rep()`.
+vctrs obeys a stricter set of recycling rules than base R. Vectors of size 1 are recycled to any other size. All other size combinations will generate an error. This strictness prevents common mistakes like `dest == c("IAH", "HOU"))`, at the cost of occasionally requiring an explicit calls to `rep()`.
 
 ```{r, echo = FALSE, fig.cap="Summary of vctrs recycling rules. X indicates n error"}
 knitr::include_graphics("../man/figures/sizes-recycling.png", dpi = 300)
@@ -344,7 +339,6 @@ You can apply the recycling rules in two ways:
     ```{r}
     vec_recycle(1:3, 3)
     vec_recycle(1, 10)
-    vec_recycle(1:3, 0)
     ```
     
 *  If you have multiple vectors and you want to recycle them to the same
@@ -353,7 +347,6 @@ You can apply the recycling rules in two ways:
     ```{r}
     vec_recycle_common(1:3, 1:3)
     vec_recycle_common(1:10, 1)
-    vec_recycle_common(integer(), 1:3)
     ```
 
 ## Appendix: recycling in base R