Allow values_fn to be an anonymous function (#1232)

* Allow `values_fn` to be an anonymous function

* NEWS bullet

* Add an example of passing an anonymous function to `values_fn`

Author: DavisVaughan

NEWS.md

@@ -1,5 +1,8 @@
 # tidyr (development version)
 
+* The `values_fn` argument of `pivot_wider()` now correctly allows anonymous
+  functions (#1114).
+
 * A number of bugs have been fixed for the grid functions, `expand_grid()`,
   `nesting()`, `crossing()`, and `expand()`:
 

R/pivot-wide.R

@@ -82,7 +82,7 @@
 #'     values_from = c(estimate, moe)
 #'   )
 #'
-#' # Can perform aggregation with values_fn
+#' # Can perform aggregation with `values_fn`
 #' warpbreaks <- as_tibble(warpbreaks[c("wool", "tension", "breaks")])
 #' warpbreaks
 #' warpbreaks %>%
@@ -91,6 +91,16 @@
 #'     values_from = breaks,
 #'     values_fn = mean
 #'   )
+#'
+#' # Can pass an anonymous function to `values_fn` when you
+#' # need to supply additional arguments
+#' warpbreaks$breaks[1] <- NA
+#' warpbreaks %>%
+#'   pivot_wider(
+#'     names_from = wool,
+#'     values_from = breaks,
+#'     values_fn = ~mean(.x, na.rm = TRUE)
+#'   )
 pivot_wider <- function(data,
                         id_cols = NULL,
                         names_from = name,
@@ -193,12 +203,13 @@ pivot_wider_spec <- function(data,
                              values_fn = NULL) {
   spec <- check_spec(spec)
 
-  if (is.function(values_fn)) {
-    values_fn <- rep_named(unique(spec$.value), list(values_fn))
+  if (is.null(values_fn)) {
+    values_fn <- list()
   }
-  if (!is.null(values_fn) && !is.list(values_fn)) {
-    abort("`values_fn` must be a NULL, a function, or a named list")
+  if (!vec_is_list(values_fn)) {
+    values_fn <- rep_named(unique(spec$.value), list(values_fn))
   }
+  values_fn <- map(values_fn, as_function)
 
   if (is_scalar(values_fill)) {
     values_fill <- rep_named(unique(spec$.value), list(values_fill))
@@ -248,7 +259,7 @@ pivot_wider_spec <- function(data,
       key = val_id,
       val = val,
       value = value,
-      summarize = values_fn[[value]]
+      values_fn = values_fn[[value]]
     )
     val_id <- dedup$key
     val <- dedup$val
@@ -329,9 +340,8 @@ name <- value <- NULL
 # Helpers -----------------------------------------------------------------
 
 # Not a great name as it now also casts
-vals_dedup <- function(key, val, value, summarize = NULL) {
-
-  if (is.null(summarize)) {
+vals_dedup <- function(key, val, value, values_fn = NULL) {
+  if (is.null(values_fn)) {
     if (!vec_duplicate_any(key)) {
       return(list(key = key, val = val))
     }
@@ -345,11 +355,10 @@ vals_dedup <- function(key, val, value, summarize = NULL) {
   }
 
   out <- vec_split(val, key)
-  if (!is.null(summarize) && !identical(summarize, list)) {
-    summarize <- as_function(summarize)
+  if (!is.null(values_fn) && !identical(values_fn, list)) {
     # This is only correct if `values_fn` always returns a single value
     # Needs https://github.com/r-lib/vctrs/issues/183
-    out$val <- vec_c(!!!map(out$val, summarize))
+    out$val <- vec_c(!!!map(out$val, values_fn))
   }
 
   out

man/pivot_wider.Rd

@@ -8,3 +8,11 @@
       * Use `values_fn = length` to identify where the duplicates arise.
       * Use `values_fn = {summary_fun}` to summarise duplicates.
 
+# values_fn is validated
+
+    Code
+      (expect_error(pivot_wider(df, values_fn = 1)))
+    Output
+      <error/rlang_error>
+      Can't convert a double vector to function
+

tests/testthat/_snaps/pivot-wide.md

@@ -145,6 +145,12 @@ test_that("values_fn can be a single function", {
   expect_equal(pv$x, c(11, 100))
 })
 
+test_that("values_fn can be an anonymous function (#1114)", {
+  df <- tibble(a = c(1, 1, 2), key = c("x", "x", "x"), val = c(1, 10, 100))
+  pv <- pivot_wider(df, names_from = key, values_from = val, values_fn = ~sum(.x))
+  expect_equal(pv$x, c(11, 100))
+})
+
 test_that("values_fn applied even when no-duplicates", {
   df <- tibble(a = c(1, 2), key = c("x", "x"), val = 1:2)
   pv <- pivot_wider(df,
@@ -157,6 +163,12 @@ test_that("values_fn applied even when no-duplicates", {
   expect_equal(as.list(pv$x), list(1L, 2L))
 })
 
+test_that("values_fn is validated", {
+  df <- tibble(name = "x", value = 1L)
+  expect_snapshot(
+    (expect_error(pivot_wider(df, values_fn = 1)))
+  )
+})
 
 # can fill missing cells --------------------------------------------------