3

假设我想根据一些特定的标准修剪一棵由 R 中嵌套列表的层次结构组成的树。我可以使用以下方法“轻松”地做到这一点lapply

# Based an example from the NetworkD3 documentation
# https://christophergandrud.github.io/networkD3/

URL <- paste0(
  "https://cdn.rawgit.com/christophergandrud/networkD3/",
  "master/JSONdata//flare.json")

flare <- jsonlite::fromJSON(URL, simplifyDataFrame = FALSE)

# Leaf nodes have a "size" attribute. Let's say we want to 
# prune all the nodes with size < 5000.

prune <- function(tree) {
  if ("children" %in% names(tree)) {
    p <- lapply(tree$children, prune)
    pp <- p[!unlist(lapply(p, is.null))]
    copied_tree = list()
    copied_tree$name = tree$name
    copied_tree$children = pp
    return(copied_tree)
  } else if (tree$size < 5000) {
    return(NULL)
  }
  return(tree)
}

pruned <- prune(flare)

R for Data Science中,Hadley Wickham讨论purrr了许多可以替换apply用于处理分层数据的函数族的场景。但是,这些示例似乎处理单个嵌套列表,或者处理深度嵌套列表的特定节点。

有没有办法用来purrr完成递归任务,比如上面讨论的那个?

4

1 回答 1

4
library(purrr)
prune_2 <- function(tree) {
  # print(tree$name)
  # print(map_lgl(tree$children, ~ "size" %in% names(.x)))
  tree$children %<>%  
    map_if(~ "children" %in% names(.x), prune_2) %>% 
    discard(~ if ("size" %in% names(.x)) .x$size < 5000 else FALSE)
  tree
}
pruned_2 <- prune_2(flare)
identical(pruned, pruned_2)
# [1] TRUE
于 2017-01-10T20:18:25.350 回答