R:在深度嵌套列表中按名称查找对象

Question

问题

我认为这应该是一个常见问题，但我找不到解决方案:

让我们假设一个深度嵌套的列表，例如:

my_list <- list(
  "first_node" = list(
    "group_a" = list(
      "E001" = 1:5,
      "E002" = list(
        "F001" = 6:10,
        "F002" = 11:15
      )
    ),
    "group_b" = list(
      "XY01" = list(
        "Z1" = LETTERS[1:5],
        "Z2" = LETTERS[6:10],
        "Z3" = list(
          "ZZ1" = LETTERS[1],
          "ZZ2" = LETTERS[2],
          "ZZ3" = LETTERS[3]
        )
      ),
      "YZ" = LETTERS[11:15]
    ),
    "group_c" = list(
      "QQQQ" = list(
        "RRRR" = 200:300
      )
    )
  ),
  "second_node" = list(
    "group_d" = list(
      "L1" = 99:101,
      "L2" = 12
    )
  )
)

期望输出

我想按名称检索元素，这些元素可能位于该列表中未知的深度级别。重要的是，我只想要那个特定的元素，它是 child ，而不是 parent 。

例如搜索 my_list为 "XY01"应该产生:

XY01 = list(
  "Z1" = LETTERS[1:5],
  "Z2" = LETTERS[6:10],
  "Z3" = list(
    "ZZ1" = LETTERS[1],
    "ZZ2" = LETTERS[2],
    "ZZ3" = LETTERS[3]
  )
)

> str(XY01)
List of 3
 $ Z1: chr [1:5] "A" "B" "C" "D" ...
 $ Z2: chr [1:5] "F" "G" "H" "I" ...
 $ Z3:List of 3
  ..$ ZZ1: chr "A"
  ..$ ZZ2: chr "B"
  ..$ ZZ3: chr "C"

以前的尝试

最初我想使用 rapply()完成这项工作，但似乎我无法访问 names()对于当前迭代。我的第二次尝试是编写自定义递归函数:

recursive_extract <- function(haystack, needle){

    lapply(names(haystack), function(x){
      if (needle %in% names(haystack[[x]])) {
        return(haystack[[needle]])
      } else {
        recursive_extract(haystack[[x]], needle)
      }
    }) %>% setNames(names(haystack))
}

...这似乎也有问题，因为 lapply()将始终返回相同的对象，即使 NULL返回，因此父结构随之而来。

我一直在查看 purrr和 rlist -packages 提供了一个方便的功能，但似乎它们中的大多数不支持递归(？)。

奖金挑战

提取所需元素后，我最好选择要返回的子级别数。例如: desired_func(haystack, needle, get_depth = 1)对于前面的示例将导致:

XY01 = list(
  "Z1" = LETTERS[1:5],
  "Z2" = LETTERS[6:10]
)

> str(XY01)
List of 2
 $ Z1: chr [1:5] "A" "B" "C" "D" ...
 $ Z2: chr [1:5] "F" "G" "H" "I" ...

非常感谢帮助! :)

Answer 1

这是一个函数，如果找到，它将返回第一个匹配项

find_name <- function(haystack, needle) {
 if (hasName(haystack, needle)) {
   haystack[[needle]]
 } else if (is.list(haystack)) {
   for (obj in haystack) {
     ret <- Recall(obj, needle)
     if (!is.null(ret)) return(ret)
   }
 } else {
   NULL
 }
}

find_name(my_list, "XY01")

我们避免 lapply所以如果发现循环可以提前中断。

列表修剪实际上是一个单独的问题。最好用不同的功能来攻击它。这应该工作

list_prune <- function(list, depth=1) {
  if (!is.list(list)) return(list)
  if (depth>1) {
    lapply(list, list_prune, depth = depth-1)
  } else  {
    Filter(function(x) !is.list(x), list)
  }
}

那么你可以做

list_prune(find_name(my_list, "XY01"), 1)

或用管道

find_name(my_list, "XY01") %>% list_prune(1)