代码之家  ›  专栏  ›  技术社区  ›  balin

R:从一个向量路径生成一个多级列表?

  •  2
  • balin  · 技术社区  · 6 年前

    我正在尝试构建一个可以递归地创建/更改列表的奇迹函数。像下面这样

    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 类似的也不允许有选择。

    2 回复  |  直到 6 年前
        1
  •  1
  •   Paweł Chabros    6 年前

    这就是你要找的吗?

    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)
    }
    
        2
  •  0
  •   balin    6 年前

    有几条弯路(参见 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)
    }