diff --git a/R/annotation.r b/R/annotation.r index 04b1bdb1fa..59c241ab4e 100644 --- a/R/annotation.r +++ b/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( diff --git a/R/performance.R b/R/performance.R index 2657e9ac09..4f51f0d1f6 100644 --- a/R/performance.R +++ b/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)) } diff --git a/tests/testthat/test-performance.R b/tests/testthat/test-performance.R index 6436e731be..5c83f2af69 100644 --- a/tests/testthat/test-performance.R +++ b/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)) + +})