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.

Sign up for GitHub

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
clauswilke merged 5 commits into from
May 16, 2019
Merged

Allow empty annotations. #3320

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
3f6e315
allow empty annotations. fixes #3317
clauswilke May 8, 2019
cee085f
fix corner case where all annotation parameters have length 1
clauswilke May 8, 2019
cfd4962
add unit tests, simplify code; closes #3314
clauswilke May 8, 2019
4ff8243
improve comments
clauswilke May 15, 2019
b313162
simplify code calculating number of rows in annotation data frame
clauswilke May 16, 2019
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
View file
Open in desktop
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) {

# To determine the final number of rows `n` in the data frame,
# we need to find the unique lengths not equal to 1L (and there
# should be at most one such length). However, if all lengths
# are equal to 1L, then the final number of rows is also 1L.
Copy link
Member

@hadley hadley May 15, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe this would be a clearer approach?

ulength <- unique(lengths)
unequal <- length(ulength) > 1 || ulength != 1

Copy link
Member Author

@clauswilke clauswilke May 15, 2019 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, that doesn't capture it. unequal should only be true if there is more than one length excluding 1. So if lengths <- c(1, 2), we should have unequal <- FALSE, but if lengths <- c(2, 3), we should have unequal <- TRUE. I'll see if I can find a better way to code this.

The original statement to calculate unequal was exactly right:

unequal <- length(unique(setdiff(lengths, 1L))) > 1L

But now I'm also trying to capture the length n in addition, that required the additional code.

Copy link
Member Author

@clauswilke clauswilke May 16, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I've thought about it some more, and I can't come up with something that would be clearer and simpler than the code in the current PR. Again, we also need to capture n, since it's used in line 64:

ggplot2/R/annotation.r

Line 64 in 4ff8243

data <- new_data_frame(position, n = n)

Copy link
Member Author

@clauswilke clauswilke May 16, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

When I woke up this morning, I realized that using setdiff() only when needed may make the code easier to understand. I pushed a new version.

n <- unique(setdiff(lengths, 1L)) # unique lengths except 1L
if (length(n) == 0L) n <- 1L # all lengths are equal to 1L

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
View file
Open in desktop
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
View file
Open in desktop
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))

})