R：从向量路径生成多级列表？

Question

我正在尝试编写一个可以递归创建/更改列表的奇迹函数。类似于以下内容

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

应该产生list(a = list(a.a = list(a.a.a = 'Something'))) 作为返回（意味着它在新列表中生成路径），或者如果lst 是一个预先存在的列表，包括路径修改它等同于lst[['a']][['a.a']][['a.a.a']] <- value - 但与路径深度无关。

如何解决这个问题？数小时的谷歌搜索和data.tree 和类似的游戏都没有选择。

Answer 1

这是你要找的吗？

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)
}

Answer 2

走了几条弯路（参见例如here 和here）并基于上面的@pawel-chabros 提示，我想出了下面的（有些复杂的）函数，它 - 正如所希望的那样 - 产生：

> # 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"

我将提出并使用它来管理我的一个项目的深层参数列表。 我无法实现的一件事是在生成时调用list_access(path = c('A', 'AA'), 'Something')（没有明确的lst 参数），而不是修改列表......

这是函数：

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)
}