use "stat" for anon functions. support formulas

Author: tjmahr

R/bayesplot-helpers.R

@@ -475,13 +475,13 @@ overlay_function <- function(...) {
 # Resolve a function name and store the expression passed in by the user
 #' @noRd
 #' @param f a function-like thing: a string naming a function, a function
-#'   object, an anonymous function object, and `NULL`.
+#'   object, an anonymous function object, a formula-based lambda, and `NULL`.
 #' @param fallback character string providing a fallback function name
 #' @return the function named in `f` with an added `"tagged_expr"` attribute
 #' containing the expression to represent the function name and an
 #' `"is_anonymous_function"` attribute to flag if the expression is a call to
 #' `function()`.
-as_tagged_function <- function(f, fallback = "func") {
+as_tagged_function <- function(f = NULL, fallback = "func") {
   qf <- enquo(f)
   f <- eval_tidy(qf)
   if (!is.null(attr(f, "tagged_expr"))) return(f)
@@ -490,17 +490,17 @@ as_tagged_function <- function(f, fallback = "func") {
   f_fn <- f
 
   if (rlang::is_character(f)) {      # f = "mean"
-    # using sym() on the evaluated `f` that a variable that names a
+    # using sym() on the evaluated `f` means that a variable that names a
     # function string `x <- "mean"; as_tagged_function(x)` will be lost
-    # but that seems okay!
+    # but that seems okay
     f_expr <- rlang::sym(f)
     f_fn <- match.fun(f)
   } else if (is_null(f)) {           # f = NULL
     f_fn <- identity
     f_expr <- rlang::sym(fallback)
   } else if (is_callable(f)) {       # f = mean or f = function(x) mean(x)
-    f_expr <- f_expr
-    f_fn <- f
+    f_expr <- f_expr                 # or f = ~mean(.x)
+    f_fn <- as_function(f)
   }
 
   # Setting attributes on primitive functions is deprecated, so wrap them
@@ -512,7 +512,8 @@ as_tagged_function <- function(f, fallback = "func") {
   }
 
   attr(f_fn, "tagged_expr") <- f_expr
-  attr(f_fn, "is_anonymous_function") <- is_call(f_expr, name = "function")
+  attr(f_fn, "is_anonymous_function") <- is_call(f_expr, name = "function") ||
+    is_formula(f_expr)
   f_fn
 }
 

R/ppc-errors.R

@@ -432,12 +432,12 @@ error_label <- function() {
 }
 
 error_avg_label <- function(stat = NULL) {
-  stat <- as_tagged_function({{ stat }}, fallback = "Average")
+  stat <- as_tagged_function({{ stat }}, fallback = "stat")
   e <- attr(stat, "tagged_expr")
-  de <- deparse1(e)
   if (attr(stat, "is_anonymous_function")) {
-    de <- paste0("(", de, ")")
+    e <- sym("stat")
   }
+  de <- deparse1(e)
   expr(paste((!!de))(italic(y) - italic(y)[rep]))
 }
 

R/ppc-scatterplots.R

@@ -223,12 +223,12 @@ ppc_scatter_avg_data <- function(y, yrep, group = NULL, stat = "mean") {
 # internal ----------------------------------------------------------------
 
 yrep_avg_label <- function(stat = NULL) {
-  stat <- as_tagged_function({{ stat }}, fallback = "Average")
+  stat <- as_tagged_function({{ stat }}, fallback = "stat")
   e <- attr(stat, "tagged_expr")
-  de <- deparse1(e)
   if (attr(stat, "is_anonymous_function")) {
-    de <- paste0("(", de, ")")
+    e <- sym("stat")
   }
+  de <- deparse1(e)
   expr(paste((!!de))(italic(y)[rep]))
 }
 

tests/testthat/test-convenience-functions.R

@@ -210,11 +210,16 @@ test_that("as_tagged_function handles string input", {
   expect_equal(attr(fn, "tagged_expr"), rlang::sym("mean"))
 })
 
-test_that("as_tagged_function handles anonymous function", {
+test_that("as_tagged_function handles anonymous functions", {
   fn <- as_tagged_function(function(x) mean(x^2))
   expect_type(fn, "closure")
   expect_equal(fn(1:3), mean((1:3)^2))
   expect_equal(attr(fn, "tagged_expr"), rlang::expr( function(x) mean(x^2)))
+
+  fn <- as_tagged_function(~mean(.x^2))
+  expect_type(fn, "closure")
+  expect_equal(fn(1:3), mean((1:3)^2))
+  expect_equal(attr(fn, "tagged_expr"), rlang::expr( ~mean(.x^2)))
 })
 
 test_that("as_tagged_function handles NULL with fallback name", {