Allow empty annotations. (#3320)

* allow empty annotations. fixes #3317

* fix corner case where all annotation parameters have length 1

* add unit tests, simplify code; closes #3314

* improve comments

* simplify code calculating number of rows in annotation data frame

Author: clauswilke

R/annotation.r

@@ -46,15 +46,22 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL,
 
   # Check that all aesthetic have compatible lengths
   lengths <- vapply(aesthetics, length, integer(1))
-  unequal <- length(unique(setdiff(lengths, 1L))) > 1L
-  if (unequal) {
+  n <- unique(lengths)
+
+  # if there is more than one unique length, ignore constants
+  if (length(n) > 1L) {
+    n <- setdiff(n, 1L)
+  }
+
+  # if there is still more than one unique length, we error out
+  if (length(n) > 1L) {
     bad <- lengths != 1L
     details <- paste(names(aesthetics)[bad], " (", lengths[bad], ")",
       sep = "", collapse = ", ")
     stop("Unequal parameter lengths: ", details, call. = FALSE)
   }
 
-  data <- new_data_frame(position, n = max(lengths))
+  data <- new_data_frame(position, n = n)
   layer(
     geom = geom,
     params = list(

R/performance.R

@@ -4,7 +4,7 @@ new_data_frame <- function(x = list(), n = NULL) {
   if (length(x) != 0 && is.null(names(x))) stop("Elements must be named", call. = FALSE)
   lengths <- vapply(x, length, integer(1))
   if (is.null(n)) {
-    n <- if (length(x) == 0) 0 else max(lengths)
+    n <- if (length(x) == 0 || min(lengths) == 0) 0 else max(lengths)
   }
   for (i in seq_along(x)) {
     if (lengths[i] == n) next
@@ -32,7 +32,7 @@ split_matrix <- function(x, col_names = colnames(x)) {
   if (!is.null(col_names)) names(x) <- col_names
   x
 }
-              
+
 mat_2_df <- function(x, col_names = colnames(x)) {
   new_data_frame(split_matrix(x, col_names))
 }

tests/testthat/test-performance.R

@@ -1,5 +1,7 @@
 context("Performance related alternatives")
 
+# modify_list() -----------------------------------------------------------
+
 testlist <- list(
   a = 5.5,
   b = "x",
@@ -32,3 +34,34 @@ test_that("modify_list erases null elements", {
   expect_null(res$c)
   expect_named(res, c('a', 'b', 'd'))
 })
+
+
+# new_data_frame() --------------------------------------------------------
+
+test_that("new_data_frame handles zero-length inputs", {
+  # zero-length input creates zero-length data frame
+  d <- new_data_frame(list(x = numeric(0), y = numeric(0)))
+  expect_equal(nrow(d), 0L)
+
+  # constants are ignored in the context of zero-length input
+  d <- new_data_frame(list(x = numeric(0), y = numeric(0), z = 1))
+  expect_equal(nrow(d), 0L)
+
+  # vectors of length > 1 don't mix with zero-length input
+  expect_error(
+    new_data_frame(list(x = numeric(0), y = numeric(0), z = 1, a = c(1, 2))),
+    "Elements must equal the number of rows or 1"
+  )
+
+  # explicit recycling doesn't work with zero-length input
+  expect_error(
+    new_data_frame(list(x = numeric(0), z = 1), n = 5),
+    "Elements must equal the number of rows or 1"
+  )
+  # but it works without
+  d <- new_data_frame(list(x = 1, y = "a"), n = 5)
+  expect_equal(nrow(d), 5L)
+  expect_identical(d$x, rep(1, 5L))
+  expect_identical(d$y, rep("a", 5L))
+
+})