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 для удобной функции, но кажется, что большинство из них не поддерживают рекурсию (?).

Bonus Challenge

После извлечения нужного элемента в идеале я бы хотел выбрать, сколько дочерних уровней вернуть. Например: 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)