Skip to content
Merged
Show file tree
Hide file tree
Changes from 3 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
8 changes: 5 additions & 3 deletions R/annotation.r
Original file line number Diff line number Diff line change
Expand Up @@ -46,15 +46,17 @@ 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(setdiff(lengths, 1L))
if (length(n) == 0L) n <- 1L # if all lengths are equal to 1L then above line fails, this fixes that
Copy link
Member

Choose a reason for hiding this comment

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

Why does it fail?

Copy link
Member Author

Choose a reason for hiding this comment

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

Maybe a poorly formulated comment. The purpose of line 49 is to find the unique lengths that are not 1L. However, if lengths == c(1L), then we get n <- numeric(0) in line 49, and we need n <- 1L in this case.


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
35 changes: 35 additions & 0 deletions tests/testthat/test-performance.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
context("Performance related alternatives")

# ********************
# modify_list()
Copy link
Member

Choose a reason for hiding this comment

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

Can you please use our standard sectioning convention?

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


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

})