Skip to content

Allow empty annotations. #3320

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
May 16, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 10 additions & 3 deletions R/annotation.r
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down
4 changes: 2 additions & 2 deletions R/performance.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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))
}
Expand Down
33 changes: 33 additions & 0 deletions tests/testthat/test-performance.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
context("Performance related alternatives")

# modify_list() -----------------------------------------------------------

testlist <- list(
a = 5.5,
b = "x",
Expand Down Expand Up @@ -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))

})