如何根据列表项递归重命名列表

这个递归函数似乎有效

names_text <- function(x) {
  if (is.list(x)) {
    if (is.null(names(x))) {
      nn <- sapply(x, function(x) if(is.list(x) & "text" %in% names(x)) x[["text"]])
      x <- lapply(x, names_text)
      setNames(x, nn)
    } else {
      lapply(x, names_text)
    }
  } else {
    x
  }
}

使用我们获得的样本数据进行测试

names_text(nodes) |> str()
List of 2
 $ RootA:List of 2
  ..$ text    : chr "RootA"
  ..$ children:List of 2
  .. ..$ ChildA1:List of 1
  .. .. ..$ text: chr "ChildA1"
  .. ..$ ChildA2:List of 1
  .. .. ..$ text: chr "ChildA2"
 $ RootB:List of 2
  ..$ text    : chr "RootB"
  ..$ children:List of 2
  .. ..$ ChildB1:List of 1
  .. .. ..$ text: chr "ChildB1"
  .. ..$ ChildB2:List of 1
  .. .. ..$ text: chr "ChildB2"

这个想法是，我们寻找未命名的列表，然后尝试从该列表中的每个子项中提取“文本”值，并将其用作名称。

这里没有太多的错误处理，也有很多关于数据结构的假设，但它适用于测试数据。

我们可以使用 purrr：modify_tree（）。

modify_tree()允许您以递归方式修改列表，提供修改每个叶或每个节点（或两者）的函数。

我们可以检查每个节点是否都有一个调用的字段，如果是，则将其用于该节点。"text"setNames()

l  <- nodes |>
    purrr::modify_tree(
        pre = \(x) {
            if ("text" %in% sapply(x, \(l) names(l))) {
                return(setNames(x, sapply(x, \(l) l$text)))
            }
            x
        }
    )

参数的定义是：pre

pre，应用于每个节点的函数。 在“向下”的方式上应用，即在叶子被转化之前，而在“向上”的方式上应用，即在叶子转化之后。postpreleafpost

我们在这里没有使用函数，因此我们可以平等地使用并且输出将是相同的。leafpost

顺便说一句，我曾用于说明目的，但由于这有时会返回 or ，因此使用通常更安全。sapply()arraymatrixunlist(lapply())

输出

R 不能很好地打印这样的列表，所以这里是 json：

jsonlite::toJSON(l, pretty = TRUE)
{
  "RootA": {
    "text": ["RootA"],
    "children": {
      "ChildA1": {
        "text": ["ChildA1"]
      },
      "ChildA2": {
        "text": ["ChildA2"]
      }
    }
  },
  "RootB": {
    "text": ["RootB"],
    "children": {
      "ChildB1": {
        "text": ["ChildB1"]
      },
      "ChildB2": {
        "text": ["ChildB2"]
      }
    }
  }
} 

只是为了确认这与硬编码输出相同：

all(
    names(l) == c(l[[1]]$text, l[[2]]$text),
    names(l[[1]]$children) == c(l[[1]]$children[[1]]$text, l[[1]]$children[[2]]$text),
    names(l[[2]]$children) == c(l[[2]]$children[[1]]$text, l[[2]]$children[[2]]$text)
) # TRUE

这很有趣。我去寻找一些非常可解释的东西。此函数循环访问所提供的列表的每个项目，如果一个项目本身是另一个列表，则调用自身。也应该能够处理未命名的列表项。

list_rename_recursive <- function(x) {

    # If not a list, return the item
    if (!is.list(x)) {

        return(x)

    } else {

        # If a list, iterate through the items of the list
        for (i in seq_along(x)) {

            # If the list item i itself is a list, call
            # the function again. The list item is updated
            # with the returned value with proper name
            # $text if found
            if (is.list(x[[i]])) {

                name_item <- NA
                if (!is.null(x[[i]]$text)) name_item <- x[[i]]$text
                x[[i]] <- list_rename_recursive(x[[i]])
                if (!is.na(name_item)) names(x)[i] <- name_item

            }

        }

        return(x)

    }

}

nodes_new <- list_rename_recursive(nodes)
str(nodes_new)

List of 2
 $ RootA:List of 2
  ..$ text    : chr "RootA"
  ..$ children:List of 2
  .. ..$ ChildA1:List of 1
  .. .. ..$ text: chr "ChildA1"
  .. ..$ ChildA2:List of 1
  .. .. ..$ text: chr "ChildA2"
 $ RootB:List of 2
  ..$ text    : chr "RootB"
  ..$ children:List of 2
  .. ..$ ChildB1:List of 1
  .. .. ..$ text: chr "ChildB1"
  .. ..$ ChildB2:List of 1
  .. .. ..$ text: chr "ChildB2"