Implement modify_tree() (#946)

Fixes #720

NAMESPACE

@@ -150,6 +150,7 @@ export(modify_at)
 export(modify_depth)
 export(modify_if)
 export(modify_in)
+export(modify_tree)
 export(negate)
 export(none)
 export(partial)

NEWS.md

@@ -92,6 +92,8 @@
   earlier so in those versions of R, the examples are automatically converted 
   to a regular section with a note that they might not work (#936).
 
+* New `modify_tree()` for recursively modifying nested data structures (#720).
+
 ### Flattening and simplification
 
 * New `list_c()`, `list_rbind()`, and `list_cbind()` make it easy to

R/map-depth.R

@@ -14,6 +14,10 @@
 #' @param .ragged If `TRUE`, will apply to leaves, even if they're not
 #'   at depth `.depth`. If `FALSE`, will throw an error if there are
 #'   no elements at depth `.depth`.
+#' @seealso [modify_tree()] for a recursive version of `modify_depth()` that
+#'   allows you to apply a function to every leaf or every node.
+#' @family map variants
+#' @family modify variants
 #' @export
 #' @examples
 #' # map_depth() -------------------------------------------------

R/modify-tree.R

@@ -0,0 +1,65 @@
+#' Recursively modify a list
+#'
+#' `modify_tree()` allows you to recursively modify a list, supplying functions
+#' that either modify each leaf or each node (or both).
+#'
+#' @param x A list.
+#' @param ... Reserved for future use. Must be empty
+#' @param leaf A function applied to each leaf.
+#' @param is_leaf A predicate function that determines whether an element is
+#'   a leaf (by returning `FALSE`) or a node (by returning `FALSE`). The
+#'   default value, `NULL`, treats lists as nodes and everything else as leaves.
+#' @param pre,post Functions applied to each node. `pre` is applied on the
+#'   way "down", i.e. before the leaves are transformed with `leaf`, while
+#'   `post` is applied on the way "up", i.e. after the leaves are transformed.
+#' @family modify variants
+#' @export
+#' @examples
+#' x <- list(list(a = 2:1, c = list(b1 = 2), b = list(c2 = 3, c1 = 4)))
+#' x |> str()
+#'
+#' # Transform each leaf
+#' x |> modify_tree(leaf = \(x) x + 100) |>  str()
+#'
+#' # Recursively sort the nodes
+#' sort_named <- function(x) {
+#'   nms <- names(x)
+#'   if (!is.null(nms)) {
+#'     x[order(nms)]
+#'   } else {
+#'     x
+#'    }
+#' }
+#' x |> modify_tree(post = sort_named) |> str()
+modify_tree <- function(x,
+                        ...,
+                        leaf = identity,
+                        is_leaf = NULL,
+                        pre = identity,
+                        post = identity) {
+  check_dots_empty()
+  leaf <- rlang::as_function(leaf)
+  if (is.null(is_leaf)) {
+    is_leaf <- function(x) {
+      !is.list(x)
+    }
+  } else {
+    is_leaf_f <- rlang::as_function(is_leaf)
+    is_leaf <- as_predicate(is_leaf_f, .mapper = FALSE, .error_arg = "is_leaf")
+  }
+  post <- rlang::as_function(post)
+  pre <- rlang::as_function(pre)
+
+  worker <- function(x) {
+    if (is_leaf(x)) {
+      out <- leaf(x)
+    } else {
+      out <- pre(x)
+      out <- modify(out, worker)
+      out <- post(out)
+    }
+    out
+  }
+
+  worker(x)
+}

R/modify.R

@@ -54,6 +54,7 @@
 #'
 #'
 #' @family map variants
+#' @family modify variants
 #' @examples
 #' # Convert factors to characters
 #' iris |>

_pkgdown.yml

@@ -51,6 +51,7 @@ reference:
   - map2
   - pmap
   - modify
+  - modify_tree
   - imap
   - lmap
 

tests/testthat/_snaps/modify-tree.md

@@ -0,0 +1,8 @@
+# validates inputs
+
+    Code
+      modify_tree(list(), is_leaf = ~1)
+    Condition
+      Error in `modify_tree()`:
+      ! `is_leaf()` must return a single `TRUE` or `FALSE`, not a number.
+

tests/testthat/test-modify-tree.R

@@ -0,0 +1,28 @@
+test_that("can modify leaves", {
+  expect_equal(
+    modify_tree(c(1, 1, 1), leaf = ~ .x + 9),
+    c(10, 10, 10)
+  )
+
+  expect_equal(
+    modify_tree(list(1, list(1, list(1))), leaf = ~ .x + 9),
+    list(10, list(10, list(10)))
+  )
+})
+
+test_that("can modify nodes", {
+  expect_equal(
+    modify_tree(list(1, list(2, list(3))), post = list_flatten),
+    list(1, 2, 3)
+  )
+})
+
+test_that("leaf() is applied to non-node input", {
+  expect_equal(modify_tree(1:3, leaf = identity), 1:3)
+})
+
+test_that("validates inputs", {
+  expect_snapshot(error = TRUE, {
+    modify_tree(list(), is_leaf = ~ 1)
+  })
+})