From 174e6251b0618e158dd00ff344ec64ba38074c36 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 19 Apr 2022 12:17:31 +0200 Subject: [PATCH 1/3] Support splicing in named arguments of `aes()` Closes #2675 --- NEWS.md | 4 ++++ R/aes.r | 40 ++++++++++++++++++++++++++++++++++-- R/utilities.r | 22 ++++++++++++++++++++ tests/testthat/_snaps/aes.md | 7 +++++++ tests/testthat/test-aes.r | 16 +++++++++++++++ 5 files changed, 87 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/_snaps/aes.md diff --git a/NEWS.md b/NEWS.md index 24399996a9..c1036a604d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # ggplot2 (development version) +* `aes()` now supports the `!!!` operator in its first two arguments + (#2675). Thanks to @yutannihilation and @teunbrand for draft + implementations. + * Require rlang >= 1.0.0 (@billybarc, #4797) * `geom_violin()` no longer issues "collapsing to unique 'x' values" warning diff --git a/R/aes.r b/R/aes.r index a5fe58269d..851f1b0e52 100644 --- a/R/aes.r +++ b/R/aes.r @@ -79,8 +79,21 @@ NULL #' cut3 <- function(x) cut_number(x, 3) #' scatter_by(mtcars, cut3(disp), drat) aes <- function(x, y, ...) { - exprs <- enquos(x = x, y = y, ..., .ignore_empty = "all") - aes <- new_aes(exprs, env = parent.frame()) + xs <- expand_quos("x") + ys <- expand_quos("y") + dots <- enquos(...) + + args <- c(xs, ys, dots) + args <- Filter(Negate(quo_is_missing), args) + + # Pass arguments to helper dummy to throw an error when duplicate + # `x` and `y` arguments are passed through dots + local({ + aes <- function(x, y, ...) NULL + inject(aes(!!!args)) + }) + + aes <- new_aes(args, env = parent.frame()) rename_aes(aes) } @@ -426,3 +439,26 @@ extract_target_is_likely_data <- function(x, data, env) { identical(data_eval, data) }, error = function(err) FALSE) } + +# Takes a quosure and returns a named list of quosures, expanding +# `!!!` expressions as needed +expand_quos <- function(name, env = caller_env()) { + # First start with `enquo0()` which does not process injection + # operators + quo <- inject(enquo0(!!sym(name)), env) + expr <- quo_get_expr(quo) + + if (!is_missing(expr) && is_triple_bang(expr)) { + # Evaluate `!!!` operand and create a list of quosures + env <- quo_get_env(quo) + xs <- eval_bare(expr[[2]][[2]][[2]], env) + xs <- lapply(xs, as_quosure, env = env) + } else { + # Redefuse `x` to process injection operators, then store in a + # length-1 list of quosures + quo <- inject(enquo(!!sym(name)), env) + xs <- set_names(list(quo), name) + } + + new_quosures(xs) +} diff --git a/R/utilities.r b/R/utilities.r index e5a667445f..71308afce4 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -604,3 +604,25 @@ split_with_index <- function(x, f, n = max(f)) { attributes(f) <- list(levels = as.character(seq_len(n)), class = "factor") unname(split(x, f)) } + +is_bang <- function(x) { + is_call(x, "!", n = 1) +} + +is_triple_bang <- function(x) { + if (!is_bang(x)) { + return(FALSE) + } + + x <- x[[2]] + if (!is_bang(x)) { + return(FALSE) + } + + x <- x[[2]] + if (!is_bang(x)) { + return(FALSE) + } + + TRUE +} diff --git a/tests/testthat/_snaps/aes.md b/tests/testthat/_snaps/aes.md new file mode 100644 index 0000000000..cba5555323 --- /dev/null +++ b/tests/testthat/_snaps/aes.md @@ -0,0 +1,7 @@ +# aes() supports `!!!` in named arguments (#2675) + + Code + (expect_error(aes(y = 1, !!!list(y = 2)))) + Output + + diff --git a/tests/testthat/test-aes.r b/tests/testthat/test-aes.r index 391d1a09d3..e1fbfa8b97 100644 --- a/tests/testthat/test-aes.r +++ b/tests/testthat/test-aes.r @@ -152,6 +152,22 @@ test_that("Warnings are issued when plots use discouraged extract usage within a expect_warning(ggplot_build(p), "Use of `df\\$x` is discouraged") }) +test_that("aes() supports `!!!` in named arguments (#2675)", { + expect_equal( + aes(!!!list(y = 1)), + aes(y = 1) + ) + expect_equal( + aes(!!!list(x = 1), !!!list(y = 2)), + aes(x = 1, y = 2) + ) + expect_equal( + aes(, , !!!list(y = 1)), + aes(y = 1) + ) + expect_snapshot((expect_error(aes(y = 1, !!!list(y = 2))))) +}) + # Visual tests ------------------------------------------------------------ test_that("aesthetics are drawn correctly", { From 176cd005ba5f6f14297169acf15568009a17c41b Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 19 Apr 2022 14:17:48 +0200 Subject: [PATCH 2/3] Disambiguate `env` and `frame` --- R/aes.r | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/aes.r b/R/aes.r index 851f1b0e52..461705b29c 100644 --- a/R/aes.r +++ b/R/aes.r @@ -442,10 +442,10 @@ extract_target_is_likely_data <- function(x, data, env) { # Takes a quosure and returns a named list of quosures, expanding # `!!!` expressions as needed -expand_quos <- function(name, env = caller_env()) { +expand_quos <- function(name, frame = caller_env()) { # First start with `enquo0()` which does not process injection # operators - quo <- inject(enquo0(!!sym(name)), env) + quo <- inject(enquo0(!!sym(name)), frame) expr <- quo_get_expr(quo) if (!is_missing(expr) && is_triple_bang(expr)) { @@ -456,7 +456,7 @@ expand_quos <- function(name, env = caller_env()) { } else { # Redefuse `x` to process injection operators, then store in a # length-1 list of quosures - quo <- inject(enquo(!!sym(name)), env) + quo <- inject(enquo(!!sym(name)), frame) xs <- set_names(list(quo), name) } From 3a21a3a623453c9924829b4ae47971f1c9d0ec55 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 19 Apr 2022 14:18:20 +0200 Subject: [PATCH 3/3] Rename `expand_quos()` to `arg_enquos()` --- R/aes.r | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/aes.r b/R/aes.r index 461705b29c..f27f676f6f 100644 --- a/R/aes.r +++ b/R/aes.r @@ -79,8 +79,8 @@ NULL #' cut3 <- function(x) cut_number(x, 3) #' scatter_by(mtcars, cut3(disp), drat) aes <- function(x, y, ...) { - xs <- expand_quos("x") - ys <- expand_quos("y") + xs <- arg_enquos("x") + ys <- arg_enquos("y") dots <- enquos(...) args <- c(xs, ys, dots) @@ -442,7 +442,7 @@ extract_target_is_likely_data <- function(x, data, env) { # Takes a quosure and returns a named list of quosures, expanding # `!!!` expressions as needed -expand_quos <- function(name, frame = caller_env()) { +arg_enquos <- function(name, frame = caller_env()) { # First start with `enquo0()` which does not process injection # operators quo <- inject(enquo0(!!sym(name)), frame)