From 3f6e3153c623eafe7125c7735160b22cb4a2390a Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Wed, 8 May 2019 11:20:32 -0500 Subject: [PATCH 1/5] allow empty annotations. fixes #3317 --- R/annotation.r | 5 +++-- R/performance.R | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/annotation.r b/R/annotation.r index 04b1bdb1fa..fbfdd3a072 100644 --- a/R/annotation.r +++ b/R/annotation.r @@ -46,7 +46,8 @@ 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 + n <- unique(setdiff(lengths, 1L)) + unequal <- length(n) > 1L if (unequal) { bad <- lengths != 1L details <- paste(names(aesthetics)[bad], " (", lengths[bad], ")", @@ -54,7 +55,7 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, 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)) } From cee085f3233633fa550b34f4ceda96ca0e496d25 Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Wed, 8 May 2019 11:59:01 -0500 Subject: [PATCH 2/5] fix corner case where all annotation parameters have length 1 --- R/annotation.r | 1 + 1 file changed, 1 insertion(+) diff --git a/R/annotation.r b/R/annotation.r index fbfdd3a072..dbe7609be2 100644 --- a/R/annotation.r +++ b/R/annotation.r @@ -47,6 +47,7 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, # Check that all aesthetic have compatible lengths lengths <- vapply(aesthetics, length, integer(1)) 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 unequal <- length(n) > 1L if (unequal) { bad <- lengths != 1L From cfd4962fe01c5cd6546a8072dd2b70fdba863469 Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Wed, 8 May 2019 12:22:42 -0500 Subject: [PATCH 3/5] add unit tests, simplify code; closes #3314 --- R/annotation.r | 4 ++-- tests/testthat/test-performance.R | 35 +++++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 2 deletions(-) diff --git a/R/annotation.r b/R/annotation.r index dbe7609be2..f237ec2db7 100644 --- a/R/annotation.r +++ b/R/annotation.r @@ -48,8 +48,8 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, lengths <- vapply(aesthetics, length, integer(1)) 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 - unequal <- length(n) > 1L - if (unequal) { + + if (length(n) > 1L) { bad <- lengths != 1L details <- paste(names(aesthetics)[bad], " (", lengths[bad], ")", sep = "", collapse = ", ") diff --git a/tests/testthat/test-performance.R b/tests/testthat/test-performance.R index 6436e731be..1a4401a6ed 100644 --- a/tests/testthat/test-performance.R +++ b/tests/testthat/test-performance.R @@ -1,5 +1,8 @@ context("Performance related alternatives") +# ******************** +# modify_list() + testlist <- list( a = 5.5, b = "x", @@ -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)) + +}) From 4ff8243cf0215e5598045811dfc2ac94cd9a39ee Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Wed, 15 May 2019 14:15:29 -0500 Subject: [PATCH 4/5] improve comments --- R/annotation.r | 9 +++++++-- tests/testthat/test-performance.R | 6 ++---- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/R/annotation.r b/R/annotation.r index f237ec2db7..f8b4a55e1c 100644 --- a/R/annotation.r +++ b/R/annotation.r @@ -46,8 +46,13 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, # Check that all aesthetic have compatible lengths lengths <- vapply(aesthetics, length, integer(1)) - 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 + + # 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. + 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 diff --git a/tests/testthat/test-performance.R b/tests/testthat/test-performance.R index 1a4401a6ed..5c83f2af69 100644 --- a/tests/testthat/test-performance.R +++ b/tests/testthat/test-performance.R @@ -1,7 +1,6 @@ context("Performance related alternatives") -# ******************** -# modify_list() +# modify_list() ----------------------------------------------------------- testlist <- list( a = 5.5, @@ -37,8 +36,7 @@ test_that("modify_list erases null elements", { }) -# ******************** -# new_data_frame() +# new_data_frame() -------------------------------------------------------- test_that("new_data_frame handles zero-length inputs", { # zero-length input creates zero-length data frame From b313162eb169febb6a8d1cd3c8ee205b2a168d4f Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Thu, 16 May 2019 08:26:52 -0500 Subject: [PATCH 5/5] simplify code calculating number of rows in annotation data frame --- R/annotation.r | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/annotation.r b/R/annotation.r index f8b4a55e1c..59c241ab4e 100644 --- a/R/annotation.r +++ b/R/annotation.r @@ -46,14 +46,14 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, # Check that all aesthetic have compatible lengths lengths <- vapply(aesthetics, length, integer(1)) + n <- unique(lengths) - # 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. - n <- unique(setdiff(lengths, 1L)) # unique lengths except 1L - if (length(n) == 0L) n <- 1L # all lengths are equal to 1L + # 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], ")",