Motivation
I am developing an R package with an essential helper function "make()". This make() function accepts a ragged list, then maps function foo() onto the penultimate nodes ("twigs") in the list: those whose children are leaves. So far purrr::map_depth(..., .depth = -2, .ragged = TRUE) seems ideal.
There is one catch: the traversal must stop at a node that is a done_box — or some sentinel class of my own creation — regardless of its depth, even though that node is also (ie. inherits from) a list of arbitrary depth. The function foo() will then map the node conditionally, based on its class.
Challenge
Unfortunately, the inflexibility of purrr::vec_depth() induces an error when it encounters objective nodes:
Error in `.f()`:
! `x` must be a vector
Run `rlang::last_error()` to see where the error occurred.
Bandaid Solution
As such, I have tentatively written a variation .map_depth() on the source code for map_depth(), where .list_depth() replaces vec_depth() to handle objective nodes. See the Code section for the code.
I can then create a sentinel class my_sentinel, which "boxes" (ie. wraps in a list) a quosure for the expression that generates the node's value. Since this my_sentinel inherits from list, then .list_depth() will give its quosure a depth of 1 and give the sentinel itself a depth of 2.
At a .depth of -2, the .map_depth() function will thus target the my_sentinel node itself. By design, foo() will identify its class as "my_sentinel", and it will evaluate the quosure to "unbox" the value.
Drawback
Unfortunately, the environment of the quosure may change since the quosure was first captured. So when .map_depth() is finally called, it might "unbox" the wrong value: one that was wrongly updated.
As such, the behavior could prove unstable for end users!
Question
Is there a cleaner or canonical way to purrr::map_*() a function foo() to the "twigs" (ie. nodes at .depth = -2) of a list, while stopping at nodes that are sentinel objects like done_box?
Suggestion
I'm curious about purrr::map_if(), with some predicate .p that tests for both class and depth. However, I lack the expertise to confirm this as feasible, let alone canonical.
Code
For my_sentinel:
my_sentinel <- function(x) {
x_quo <- rlang::enquo0(x)
# No pun intended.
x_box <- list(x_quo)
structure(x_box,
class = c("my_sentinel", class(x_box))
)
}
For .map_depth():
# A variation on 'purrr::map_depth()' that accommodates objective leaves.
.map_depth <- function(.x, .depth, .f, ..., .ragged = FALSE) {
if (!rlang::is_integerish(.depth, n = 1, finite = TRUE)) {
abort("`.depth` must be a single number")
}
if (.depth < 0) {
.depth <- .list_depth(.x) + .depth
}
.f <- purrr::as_mapper(.f, ...)
.map_depth_rec(.x, .depth, .f, ..., .ragged = .ragged, .atomic = FALSE)
}
# A variation on 'purrr:::map_depth_rec()' that accommodates objective leaves.
.map_depth_rec <- function(.x, .depth, .f, ..., .ragged, .atomic) {
if (.depth < 0) {
rlang::abort("Invalid depth")
}
# TODO: Must this be addressed too (unlikely)?
if (.atomic) {
if (!.ragged) {
rlang::abort("List not deep enough")
}
return(purrr::map(.x, .f, ...))
}
if (.depth == 0) {
return(.f(.x, ...))
}
if (.depth == 1) {
return(purrr::map(.x, .f, ...))
}
.atomic <- rlang::is_atomic(.x)
purrr::map(.x, function(x) {
.map_depth_rec(x, .depth - 1, .f, ..., .ragged = .ragged,
.atomic = .atomic)
})
}
# A variation on 'purrr::vec_depth()' that accommodates objective leaves.
.list_depth <- function(x) {
if (rlang::is_null(x)) {
0L
}
# TODO: Address this so a vector is treated as a leaf (or must users esc() for that?).
else if (rlang::is_atomic(x)) {
1L
}
else if (rlang::is_list(x)) {
depths <- purrr::map_int(x, .list_depth)
1L + max(depths, 0L)
}
# Accommodate objective leaves.
else if (is.object(x)) {
# TODO: Check if this should be 1L or (as I suspect) 0L!
1L
}
else {
rlang::abort("`x` must be a vector or an object")
}
}
