R/nest.R

In jeanmathieupotvin/dotprofile: Create and Manage Configuration Profiles

#' Nest a value in a list
#'
#' Embed a value into a [list][base::list()] (possibly named) that has an
#' arbitrary number of levels.
#'
#' @param levels `[integer(1) | character]`
#'
#'   Either the desired number of levels or their explicit names. For the
#'   latter, the last element of `levels` is the name of the last node. It
#'   is not considered to be a *level*. Any [integer][base::integer()]
#'   passed to this argument must be greater than or equal to `0`.
#'
#' @param value `[any]`
#'
#'   Value to be nested.
#'
#' @returns A [list][base::list()], possibly named if `levels` is a
#'   `character` vector, with a number of levels prescribed by `levels`.
#'   If `levels` is either `0` or `character(0L)`, [nest()] simply returns
#'   `value`. See details.
#'
#' @details Function [nest()] embeds (*nests*) `value` into a tree.
#'   Each node is a [list][base::list()], except for the last one
#'   which is set equal to `value`. Nodes are named if non-empty
#'   strings are passed to `levels`. See examples.
#'
#'   ```
#'   <level 0> (top-level)
#'   │
#'   └── <level 1>
#'       │
#'       └── <level 2>
#'           │
#'           └── <...>
#'               │
#'               └── <terminal node>
#'                   │
#'                   └── value
#'   ```
#'
#'   As an example, calling `nest(c("lvl1", "lvl2", "terminal_node"))` yields
#'   the following tree.
#'
#'   ```
#'   list(lvl1 =
#'   │
#'   └── list(lvl 2 =
#'       │
#'       └── list(terminal_node =
#'           │
#'           └── value)))
#'   ```
#'
#'   Passing either `0L` or `character(0L)` to argument `levels` yields
#'   a degenerate case: it implies `value` should not be nested into any
#'   list.
#'
#' @examples
#' ## Nest a value into a list of 0, 1, 2, or 3 levels.
#' nest(0L, "my nested value")
#' nest(1L, "my nested value")
#' nest(2L, "my nested value")
#' nest(3L, "my nested value")
#'
#' ## Nest a value into a complex tree of 100 levels.
#' nest(100L, "deeply nested value")
#'
#' ## Nest a NULL value into a tree of named lists.
#' x <- nest(c("level_1", "level_2", "level_3", "terminal_node"))
#' y <- list(
#'     level_1 = list(
#'         level_2 = list(
#'             level_3 = list(terminal_node = NULL))))
#'
#' identical(x, y) # TRUE
#'
#' ## You can nest any R object, even other lists.
#' nest(3L, value = nest(3L, value = "Hey!"))
#'
#' @export
nest <- function(levels, value = NULL)
{
    if (is_scalar_dbl(levels)) {
        levels <- as.integer(levels)
    }

    if (!is_chr(levels) && !is_scalar_int(levels)) {
        ui_stop(
            "{.arg levels} must be a {.code character} or" %+%
            "an {.code integer(1)} greater than or equal to 0.")
    }

    # Argument `levels` can be an integer
    # specifying the desired total number
    # of levels (including top-level), or
    # a character vector of names naming
    # them. For the latter, the last name
    # passed to `levels` will be the name
    # of the terminal node (`value`).
    if (is_int(levels)) {

        if (levels < 0L) {
            ui_stop("{.arg levels} must be greater than or equal to 0.")
        }

        lvls <- seq_len(levels)
        x    <- value

        # For each desired level, embed the
        # previous level into a list. The
        # process starts from `value`. This
        # process is very fast (~30ns),
        # because embedding lists does not
        # trigger any copy in memory.
        for (lvl in lvls) {
            x <- list(x)
        }
    } else {

        # We embed `value` recursively,
        # starting from this terminal node
        # (backward). Therefore, we reverse
        # names passed to `levels`.
        lvls <- rev(levels)
        x    <- value

        # For each desired level, embed the
        # previous level into a list, just
        # like above. However, we also add
        # names to each level. This is still
        # very fast because setting names
        # also does not trigger any copy in
        # memory.
        for (lvl in lvls) {
            x <- list(x)
            names(x) <- lvl
        }
    }

    return(x)
}