Use vec_is_list() in map_depth()

NAMESPACE

@@ -20,7 +20,6 @@ S3method(modify_at,default)
 S3method(modify_at,double)
 S3method(modify_at,integer)
 S3method(modify_at,logical)
-S3method(modify_depth,default)
 S3method(modify_if,character)
 S3method(modify_if,default)
 S3method(modify_if,double)

NEWS.md

@@ -63,10 +63,6 @@
 * Some mapping functions have now a `.progress` argument to create a
   progress bar. See `?progress_bars` (#149).
 
-* purrr is now licensed as MIT (#805).
-
-### Flattening and simplification
-
 * New `list_c()`, `list_rbind()`, and `list_cbind()` make it easy to
   `c()`, `rbind()`, or `cbind()` all of the elements in a list.
 
@@ -136,6 +132,12 @@
 
 ## Minor improvements and bug fixes
 
+* `modify_depth()` is no longer a generic. This makes it more consistent
+  with `map_depth()`.
+
+* `map_depth()` now uses `is.list()` to determine if there's more depth
+  to recurse into, as opposed to `!is_atomic(.x)` (#920).
+
 * `as_mapper()` is now around twice as fast when used with character,
   integer, or list (#820).
 

R/map-depth.R

@@ -0,0 +1,138 @@
+#' Map/modify elements at given depth
+#'
+#' `map_depth()` calls `map(.y, .f)` on all `.y` at the specified `.depth` in
+#' `.x`. `modify_depth()` calls `modify(.y, .f)` on `.y` at the specified
+#' `.depth` in `.x`.
+#'
+#' @inheritParams map
+#' @param .depth Level of `.x` to map on. Use a negative value to
+#'   count up from the lowest level of the list.
+#'
+#'   * `map_depth(x, 0, fun)` is equivalent to `fun(x)`.
+#'   * `map_depth(x, 1, fun)` is equivalent to `x <- map(x, fun)`
+#'   * `map_depth(x, 2, fun)` is equivalent to `x <- map(x, ~ map(., fun))`
+#' @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`.
+#' @export
+#' @examples
+#' # map_depth() -------------------------------------------------
+#' # Use `map_depth()` to recursively traverse nested vectors and map
+#' # a function at a certain depth:
+#' x <- list(a = list(foo = 1:2, bar = 3:4), b = list(baz = 5:6))
+#' str(x)
+#' map_depth(x, 2, paste, collapse = "/")
+#'
+#' # Equivalent to:
+#' map(x, map, paste, collapse = "/")
+#'
+#' # When ragged is TRUE, `.f()` will also be passed leaves at depth < `.depth`
+#' x <- list(1, list(1, list(1, list(1, 1))))
+#' str(x)
+#' str(map_depth(x, 4, ~ length(unlist(.x)), .ragged = TRUE))
+#' str(map_depth(x, 3, ~ length(unlist(.x)), .ragged = TRUE))
+#' str(map_depth(x, 2, ~ length(unlist(.x)), .ragged = TRUE))
+#' str(map_depth(x, 1, ~ length(unlist(.x)), .ragged = TRUE))
+#' str(map_depth(x, 0, ~ length(unlist(.x)), .ragged = TRUE))
+#'
+#' # modify_depth() -------------------------------------------------
+#' l1 <- list(
+#'   obj1 = list(
+#'     prop1 = list(param1 = 1:2, param2 = 3:4),
+#'     prop2 = list(param1 = 5:6, param2 = 7:8)
+#'   ),
+#'   obj2 = list(
+#'     prop1 = list(param1 = 9:10, param2 = 11:12),
+#'     prop2 = list(param1 = 12:14, param2 = 15:17)
+#'   )
+#' )
+#'
+#' # In the above list, "obj" is level 1, "prop" is level 2 and "param"
+#' # is level 3. To apply sum() on all params, we map it at depth 3:
+#' l1 %>% modify_depth(3, sum) %>% str()
+#'
+#' # Note that vectorised operations will yield the same result when
+#' # applied at the list level as when applied at the atomic result.
+#' # The former is more efficient because it takes advantage of
+#' # vectorisation.
+#' l1 %>% modify_depth(3, `+`, 100L)
+#' l1 %>% modify_depth(4, `+`, 100L)
+#'
+#' # modify() lets us pluck the elements prop1/param2 in obj1 and obj2:
+#' l1 %>% modify(c("prop1", "param2")) %>% str()
+#'
+#' # But what if we want to pluck all param2 elements? Then we need to
+#' # act at a lower level:
+#' l1 %>% modify_depth(2, "param2") %>% str()
+#'
+#' # modify_depth() can be with other purrr functions to make them operate at
+#' # a lower level. Here we ask pmap() to map paste() simultaneously over all
+#' # elements of the objects at the second level. paste() is effectively
+#' # mapped at level 3.
+#' l1 %>% modify_depth(2, ~ pmap(., paste, sep = " / ")) %>% str()
+map_depth <- function(.x, .depth, .f, ..., .ragged = FALSE) {
+  if (!is_integerish(.depth, n = 1, finite = TRUE)) {
+    abort("`.depth` must be a single number")
+  }
+  if (.depth < 0) {
+    .depth <- pluck_depth(.x) + .depth
+  }
+
+  .f <- as_mapper(.f, ...)
+  map_depth_rec(map, .x, .depth, .f, ..., .ragged = .ragged)
+}
+
+#' @rdname map_depth
+#' @export
+modify_depth <- function(.x, .depth, .f, ..., .ragged = .depth < 0) {
+  if (!is_integerish(.depth, n = 1, finite = TRUE)) {
+    abort("`.depth` must be a single number")
+  }
+  if (.depth < 0) {
+    .depth <- pluck_depth(.x) + .depth
+  }
+
+  .f <- as_mapper(.f, ...)
+  map_depth_rec(modify, .x, .depth, .f, ..., .ragged = .ragged)
+}
+
+map_depth_rec <- function(.fmap,
+                          .x,
+                          .depth,
+                          .f,
+                          ...,
+                          .ragged,
+                          .error_call = caller_env()) {
+  if (.depth < 0) {
+    cli::cli_abort("Invalid depth", call = .error_call)
+  } else if (.depth == 0) {
+    if (identical(.fmap, map)) {
+      .f(.x, ...)
+    } else {
+      .x[] <- .f(.x, ...)
+      .x
+    }
+  } else if (.depth == 1) {
+    .fmap(.x, .f, ...)
+  } else {
+    if (is.list(.x)) {
+      .fmap(.x, function(x) {
+        map_depth_rec(
+          .fmap = .fmap,
+          .x = x,
+          .depth = .depth - 1,
+          .f = .f,
+          ...,
+          .ragged = .ragged,
+          .error_call = .error_call
+        )
+      })
+    } else {
+      if (.ragged) {
+        .fmap(.x, .f, ...)
+      } else {
+        cli::cli_abort("List not deep enough", call = .error_call)
+      }
+    }
+  }
+}

R/map-if-at.R

@@ -1,7 +1,6 @@
 #' Apply a function to each element of a vector conditionally
 #'
 #' @description
-#'
 #' The functions `map_if()` and `map_at()` take `.x` as input, apply
 #' the function `.f` to some of the elements of `.x`, and return a
 #' list of the same length as the input.
@@ -71,73 +70,3 @@ map_at <- function(.x, .at, .f, ..., .progress = NULL) {
 
   set_names(out, names(.x))
 }
-
-
-#' @rdname map_if
-#' @description * `map_depth()` allows to apply `.f` to a specific
-#'   depth level of a nested vector.
-#' @param .depth Level of `.x` to map on. Use a negative value to
-#'   count up from the lowest level of the list.
-#'
-#'   * `map_depth(x, 0, fun)` is equivalent to `fun(x)`.
-#'   * `map_depth(x, 1, fun)` is equivalent to `x <- map(x, fun)`
-#'   * `map_depth(x, 2, fun)` is equivalent to `x <- map(x, ~ map(., fun))`
-#' @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`.
-#' @examples
-#'
-#' # Use `map_depth()` to recursively traverse nested vectors and map
-#' # a function at a certain depth:
-#' x <- list(a = list(foo = 1:2, bar = 3:4), b = list(baz = 5:6))
-#' str(x)
-#' map_depth(x, 2, paste, collapse = "/")
-#'
-#' # Equivalent to:
-#' map(x, map, paste, collapse = "/")
-#' @export
-map_depth <- function(.x, .depth, .f, ..., .ragged = FALSE) {
-  if (!is_integerish(.depth, n = 1, finite = TRUE)) {
-    abort("`.depth` must be a single number")
-  }
-  if (.depth < 0) {
-    .depth <- pluck_depth(.x) + .depth
-  }
-
-  .f <- as_mapper(.f, ...)
-  map_depth_rec(.x, .depth, .f, ..., .ragged = .ragged, .atomic = FALSE)
-}
-
-map_depth_rec <- function(.x,
-                          .depth,
-                          .f,
-                          ...,
-                          .ragged,
-                          .atomic) {
-  if (.depth < 0) {
-    abort("Invalid depth")
-  }
-
-  if (.atomic) {
-    if (!.ragged) {
-      abort("List not deep enough")
-    }
-    return(map(.x, .f, ...))
-  }
-
-  if (.depth == 0) {
-    return(.f(.x, ...))
-  }
-
-  if (.depth == 1) {
-    return(map(.x, .f, ...))
-  }
-
-  # Should this be replaced with a generic way of figuring out atomic
-  # types?
-  .atomic <- is_atomic(.x)
-
-  map(.x, function(x) {
-    map_depth_rec(x, .depth - 1, .f, ..., .ragged = .ragged, .atomic = .atomic)
-  })
-}

R/modify.R

@@ -16,9 +16,6 @@
 #'   elements of `.y` to `.f`, just like [map2()]. `imodify()` passes
 #'   the names or the indices to `.f` like [imap()] does.
 #'
-#' * `modify_depth()` only modifies elements at a given level of a
-#'   nested data structure.
-#'
 #' * [modify_in()] modifies a single element in a [pluck()] location.
 #'
 #' @param .x A vector.
@@ -27,12 +24,6 @@
 #' @inheritParams map
 #' @param .f A function specified in the same way as the corresponding map
 #'   function.
-#' @param .depth Level of `.x` to map on. Use a negative value to count up
-#'   from the lowest level of the list.
-#'
-#'   * `modify_depth(x, 0, fun)` is equivalent to `x[] <- fun(x)`.
-#'   * `modify_depth(x, 1, fun)` is equivalent to `x <- modify(x, fun)`
-#'   * `modify_depth(x, 2, fun)` is equivalent to `x <- modify(x, ~ modify(., fun))`
 #' @return An object the same class as `.x`
 #'
 #' @details
@@ -93,42 +84,6 @@
 #' # Specify an alternative with the `.else` argument:
 #' modify_if(iris, is.factor, as.character, .else = as.integer)
 #'
-#'
-#' # Modify at specified depth ---------------------------
-#' l1 <- list(
-#'   obj1 = list(
-#'     prop1 = list(param1 = 1:2, param2 = 3:4),
-#'     prop2 = list(param1 = 5:6, param2 = 7:8)
-#'   ),
-#'   obj2 = list(
-#'     prop1 = list(param1 = 9:10, param2 = 11:12),
-#'     prop2 = list(param1 = 12:14, param2 = 15:17)
-#'   )
-#' )
-#'
-#' # In the above list, "obj" is level 1, "prop" is level 2 and "param"
-#' # is level 3. To apply sum() on all params, we map it at depth 3:
-#' l1 %>% modify_depth(3, sum) %>% str()
-#'
-#' # Note that vectorised operations will yield the same result when
-#' # applied at the list level as when applied at the atomic result.
-#' # The former is more efficient because it takes advantage of
-#' # vectorisation.
-#' l1 %>% modify_depth(3, `+`, 100L)
-#' l1 %>% modify_depth(4, `+`, 100L)
-#'
-#' # modify() lets us pluck the elements prop1/param2 in obj1 and obj2:
-#' l1 %>% modify(c("prop1", "param2")) %>% str()
-#'
-#' # But what if we want to pluck all param2 elements? Then we need to
-#' # act at a lower level:
-#' l1 %>% modify_depth(2, "param2") %>% str()
-#'
-#' # modify_depth() can be with other purrr functions to make them operate at
-#' # a lower level. Here we ask pmap() to map paste() simultaneously over all
-#' # elements of the objects at the second level. paste() is effectively
-#' # mapped at level 3.
-#' l1 %>% modify_depth(2, ~ pmap(., paste, sep = " / ")) %>% str()
 #' @export
 modify <- function(.x, .f, ...) {
   UseMethod("modify")
@@ -318,61 +273,6 @@ modify_base <- function(mapper, .x, .y, .f, ...) {
   .x
 }
 
-#' @rdname modify
-#' @export
-modify_depth <- function(.x, .depth, .f, ..., .ragged = .depth < 0) {
-  if (!is_integerish(.depth, n = 1, finite = TRUE)) {
-    abort("`.depth` must be a single number")
-  }
-  UseMethod("modify_depth")
-}
-#' @rdname modify
-#' @export
-modify_depth.default <- function(.x, .depth, .f, ..., .ragged = .depth < 0) {
-  force(.ragged)
-
-  if (.depth < 0) {
-    .depth <- pluck_depth(.x) + .depth
-  }
-
-  .f <- as_mapper(.f, ...)
-  modify_depth_rec(.x, .depth, .f, ..., .ragged = .ragged, .atomic = FALSE)
-}
-
-modify_depth_rec <- function(.x, .depth, .f,
-                             ...,
-                             .ragged = FALSE,
-                             .atomic = FALSE) {
-  if (.depth < 0) {
-    abort("Invalid depth")
-  }
-
-  if (.atomic) {
-    if (!.ragged) {
-      abort("List not deep enough")
-    }
-    return(modify(.x, .f, ...))
-  }
-
-  if (.depth == 0) {
-    # TODO vctrs: Use `vec_cast()` on result?
-    .x[] <- .f(.x, ...)
-    return(.x)
-  }
-
-  if (.depth == 1) {
-    return(modify(.x, .f, ...))
-  }
-
-  # Should this be replaced with a generic way of figuring out atomic
-  # types?
-  .atomic <- is_atomic(.x)
-
-  modify(.x, function(x) {
-    modify_depth_rec(x, .depth - 1, .f, ..., .ragged = .ragged, .atomic = .atomic)
-  })
-}
-
 # Internal version of map_lgl() that works with logical vectors
 probe <- function(.x, .p, ...) {
   if (is_logical(.p)) {

_pkgdown.yml

@@ -47,6 +47,7 @@ reference:
     `imap()` (index map) is a shortcut for the common pattern `map2(x, names(x))`.
   contents:
   - map_if
+  - map_depth
   - map2
   - pmap
   - modify