R: Generating a multiple level list from a vector path?

Question

I'm trying to cook up a miracle function that will recursively create/change a list. Something like the following

miracle <- function(lst = NULL, path = c('a', 'a.a', 'a.a.a'), value = 'Something')
{
  if(is.null(lst)) lst <- list()
  <MIRACLE HERE>
  return(lst)
}

should produce list(a = list(a.a = list(a.a.a = 'Something'))) as a return (meaning it generates the path in a new list), or if lst is a preexisting list including the path modifies it equivalent to lst[['a']][['a.a']][['a.a.a']] <- value - but independent of the path depth.

How to go about this? Hours of googling and playing with data.tree and similar have not let to options.

Answer 1

With several detours (see e.g. here and here) and based on @pawel-chabros hint above, I came up with the (somewhat elaborate) function(s) below, which -as hoped for- produce:

> # Create a deep list
> example_list <- list_access(list(), path = c('A', 'AA', 'AAA', 'AAAA'),'Something')
> str(example_list)
List of 1
 $ A:List of 1
  ..$ AA:List of 1
  .. ..$ AAA:List of 1
  .. .. ..$ AAAA: chr "Something"
> # Modify the list
> example_list <- list_access(example_list, path = c('A', 'AA', 'AAB'), 'Something else')
> str(example_list)
List of 1
 $ A:List of 1
  ..$ AA:List of 2
  .. ..$ AAA:List of 1
  .. .. ..$ AAAA: chr "Something"
  .. ..$ AAB: chr "Something else"
> # Access an element
> list_access(example_list, path = c('A', 'AA', 'AAA', 'AAAA'))
[1] "Something"
> # Access multiple elements
> list_access(example_list, path = list(c('A', 'AA', 'AAA', 'AAAA'), c('A', 'AA', 'AAB')))
[1] "Something"      "Something else"
> # Delete an element
> example_list <- list_access(lst = example_list, path = c('A', 'AA', 'AAB'), NULL)
> str(example_list)
List of 1
 $ A:List of 1
  ..$ AA:List of 1
  .. ..$ AAA:List of 1
  .. .. ..$ AAAA: chr "Something"
> # Multiple edits
> example_list <- list_access(example_list,
    path = list( c('A', 'AA', 'AAB'), c('A', 'AB'), c('B', 'BA', 'BAA')),
    'Something else (again)', 'Entirely different', 'Weird and beautiful')
> str(example_list)
List of 2
 $ A:List of 2
  ..$ AA:List of 2
  .. ..$ AAA:List of 1
  .. .. ..$ AAAA: chr "Something"
  .. ..$ AAB: chr "Something else (again)"
  ..$ AB: chr "Entirely different"
 $ B:List of 1
  ..$ BA:List of 1
  .. ..$ BAA: chr "Weird and beautiful"

I shall set forth and use this to manage deep parameter lists for one of my projects. The one thing I was unable to achieve was calling list_access(path = c('A', 'AA'), 'Something') (without an explicit lst argument) when generating, not modifying a list ...

Here's the function(s):

library(assertive.base)
library(magrittr)
library(purrr)
list_access <- function(lst = list(), path, ...) {
  # Capture parameters ------------------------------------------------------
  value <- list(...) %>%
    unlist(recursive = FALSE)
  retrieve <- missing(...)
  # <Input checking omited>
  # Processing --------------------------------------------------------------
  # Branch: insert or retrieve value
  ## Retrieve
  if(retrieve){
    ### Multiple retrievals
    if(is.list(path)){
      output <- sapply(
        path,
        function(x){
          #### Check for path existence
          preexists <- list_path_preexists(lst, x)
          if(retrieve) assertive.base::assert_all_are_true(preexists)
          tmp_lst <- lst
          for(pi in x){
            tmp_lst %<>%
              magrittr::extract2(pi)
          }
          return(tmp_lst)
        }
      )
    ### Single retrieval
    } else {
      #### Check for path existence
      preexists <- list_path_preexists(lst, path)
      if(retrieve) assertive.base::assert_all_are_true(preexists)
      output <- lst
      for(pi in path){
        output %<>%
          magrittr::extract2(pi)
      }
    }
  ## Insert
  } else {
    output <- lst
    ### Multiple inserts
    if(is.list(path)){
      for(i in seq_along(path)){
        modifier <- list()
        tmp_path <- path[[i]]
        for (ii in length(tmp_path):1){
          ptemp <- tmp_path[ii]
          if(ii == length(tmp_path)){
            modifier[ptemp] <- list(value[i]) # `NULL`-compatible assignment
          } else {
            modifier[[ptemp]] <- modifier
            modifier[[1]] <- NULL
          }
        }
        output %<>%
          purrr::list_modify(!!!modifier)
      }
    ### Single Insert
    } else {
      modifier <- list()
      for (i in length(path):1) {
        ptemp = path[i]
        if (i == length(path)) {
          modifier[ptemp] <- list(value[1]) # `NULL`-compatible assignment
        } else {
          modifier[[ptemp]] = modifier
          modifier[[1]] <- NULL
        }
      }
      output %<>%
        purrr::list_modify(!!!modifier)
    }
  }
  # Final return
  return(output)
}

list_path_preexists <- function(lst, path){
  # Create object to hold info
  preexists <- rep(FALSE, length(path))
  # Return where nothing to evaluate
  if(is.null(lst)) return(preexists)
  # Assure expected data type
  #assertive.types::assert_is_list(lst)
  # Generate temp object to hold content of increasing depth
  tmp_lst <- lst
  # Iterate over path
  for (lvi in seq_along(path)){
    ## Retrieve path item
    lv <- path[[lvi]]
    ## No further evaluation if not path item not in names - branch tip reached.
    if(!(lv %in% names(tmp_lst))) break()
    ## Indicate preixistence
    preexists %<>%
      magrittr::inset2(lvi, TRUE)
    ## Assure that non-tip entry is a list to add to
    if(lvi != length(path) && !is.list(tmp_lst)) stop('Preexisting non-tip entry is NOT a list:', lv)
    ## Descent further into lst
    tmp_lst %<>%
      magrittr::extract2(lv)
  }
  # Return result
  return(preexists)
}

Answer 2

Is this what you are looking for?

miracle <- function(lst = NULL, path = c('a', 'a.a', 'a.a.a'), value = 'Something') {
  if (length(path) == 1) {
    lst[[path[1]]] <- value
    return(lst)
  }
  temp <- list()
  for (i in length(path):2) {
    ptemp = path[i]
    if (i == length(path)) {
      temp[[ptemp]] = value
    } else {
      temp[[ptemp]] = temp
      temp[[1]] <- NULL
    }
  }
  lst[[path[i-1]]] <- temp
  return(lst)
}