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

期望的输出

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

例如，在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)

Answer 2

我们也可以在rrapply-package（base-rapply的扩展）中使用rrapply。

首先，查找XY01在嵌套列表中的位置：

library(rrapply)

(XY01_pos <- rrapply(my_list, 
                    classes = "list",
                    condition = function(x, .xname) .xname == "XY01", 
                    f = function(x, .xpos) .xpos, 
                    how = "flatten")[[1]])
#> [1] 1 2 1

在这里，我们使用了.xname 和.xpos 参数，它们计算出正在计算的列表元素的名称和位置。 how = "flatten" 返回修剪后列表的扁平版本，在这种情况下仅包含 XY01 的位置。

其次，通过嵌套列表的普通子集化返回子列表：

str(my_list[[XY01_pos]])
#> 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"

对于奖励挑战，我们可以再次调用 rrapply 应用于子列表 my_list[[XY01]]，返回一个修剪后的列表，其中仅包含深度小于或等于预先指定的最大深度的节点：

maxdepth <- 1
rrapply(my_list[[XY01_pos]], condition = function(x, .xpos) length(.xpos) <= maxdepth, how = "prune")
#> $Z1
#> [1] "A" "B" "C" "D" "E"
#> 
#> $Z2
#> [1] "F" "G" "H" "I" "J"

这里length(.xpos) 评估为正在评估的列表元素的深度，因此我们只返回满足length(.xpos) <= maxdepth 的节点。

---

注意：我们也可以通过设置 how = "prune" 来调用 rrapply 直接返回 XY01 的子代：

str(rrapply(my_list, classes = "list", condition = function(x, .xname) .xname == "XY01", how = "prune"))
#> List of 1
#>  $ first_node:List of 1
#>   ..$ group_b:List of 1
#>   .. ..$ 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"

但这将包含从根开始而不是从XY01 节点开始的完整节点路径。