如何修改find_specific_list函数以保留指定命名列表？

已知remove_empty函数可迭代移除嵌套列表中的NA列表，现需修改自定义的find_specific_list函数，实现仅保留所有层级中名称等于指定值的列表元素，丢弃其余内容，但当前函数运行报错，需解决。

原代码及报错信息 #

library(tidyverse)

# 测试嵌套列表数据
x <- list(seta = c(lista = list(c("A", "B"),
                                listb = NA, 
                                listc = NA, 
                                listd = NA)), 
          setb = c(lista2 = list(c("C","E"), 
                                 listb2 = NA, 
                                 listc2 = "D", 
                                 listd2 = NA, 
                                 liste2 = NA))
)

# 可正常运行的移除NA列表函数
remove_empty <- function(x){
  if(is.list(x)) {
    x %>%
      purrr::discard(rlang::is_na) %>%
      purrr::map(remove_empty)
  } else {
    x
  }
}

# 报错的自定义函数
find_specific_list <- function(x,y){
  
  if(is.list(x)) {
    x %>%
      purrr::discard(function(x){
        names(x) == y
      })%>%
      purrr::map(find_specific_list)
  } else {
    x
  }
}

# 测试调用
y <- "lista2"
find_specific_list(x,y)
#> Error in `.f()`:
#> ! Predicate functions must return a single `TRUE` or `FALSE`, not a logical vector of length 4

问题分析 #

1. 报错根源：purrr::discard要求谓词函数对每个列表元素返回单个布尔值，但原函数中names(x)获取的是当前元素的子元素名称（而非当前元素自身的名称），返回长度大于1的逻辑向量，导致参数不匹配报错。
2. 逻辑倒置：需求是保留指定名称元素，原函数却使用discard（丢弃）操作，与目标逻辑相反。

修正后的函数 #

find_specific_list <- function(x, y){
  if(is.list(x)) {
    x %>%
      # 保留当前列表中名称等于目标值的元素
      purrr::keep(names(.) == y) %>%
      # 递归处理保留的元素，继续筛选深层嵌套的指定名称元素
      purrr::map(find_specific_list, y = y)
  } else {
    # 非列表元素直接返回
    x
  }
}

测试示例 #

# 保留所有层级中名称为"lista"的元素
find_specific_list(x, "lista")
#> $seta
#> $seta$lista
#> [1] "A" "B"

# 保留所有层级中名称为"lista2"的元素
find_specific_list(x, "lista2")
#> $setb
#> $setb$lista2
#> [1] "C" "E"

内容的提问来源于stack exchange，提问作者MaskofIllusion