r - 以/分隔的嵌套列表的列

Question

我有一列，其中每个行元素都由“/ ”分隔:

data.frame(column=c("a","a/air","a/aero/breath","b","b/boy","b/bag/band/brand"))

如何在每个“ / ”之后将其转换为嵌套列表。所以目标是获得:

list(a=list("air"=1,aero=list("breath"=1)),b=list("boy"=1,bag=list(band=list("brand"=1)))) 

我需要这个用于 ShinyTree 包来从列中制作一棵树。
我在层次结构中的最后一个元素的末尾添加了“=1”，因为它需要显示在 ShinyTree 输出中。然后可以将列表放入下面的代码中以获取 tree :

library(shiny)
library(shinyTree)

tree <- list(a=list("air"=1,aero=list("breath"=1)),b=list("boy"=1,bag=list(band=list("brand"=1)))) 


typeof(tree)

ui <- fluidPage(
  fluidPage(
    sidebarLayout(
      sidebarPanel(
        actionButton('reset', 'Reset nodes')
      ),
      mainPanel(
        shinyTree("tree", ),
        hr(),
        "Selected nodes:",
        verbatimTextOutput("idSelected")#,
      )
    )
  )
)

server <- function(input, output, session) {
  
  treeSelection <- reactiveVal(list())
  
  output$tree = renderTree({
    tree
  })
  
  observeEvent(input$reset, {
    updateTree(session, "tree", data = tree)
    treeSelection(list())
  })
  
  observeEvent(input$tree, {
    treeSelection(get_selected(input$tree, format = "classid"))
  })
  
  output$idSelected <- renderPrint({
    treeSelection()
  })
  
}

shinyApp(ui, server)

Answer 1

由于变量看起来像路径，我将样本数据创建为向量

paths <- c(
  "a",
  "a/air",
  "a/aero/breath",
  "b",
  "b/boy",
  "b/bag/band/brand"
)

然后您可以使用以下函数来获取嵌套列表。我希望变量名的选择具有足够的解释性。

pathsToNestedList <- function(x) {
  pathSplit <- strsplit(x,"/")
  pathStarts <- sapply(pathSplit,"[[",1)
  uniquePathStarts <- unique(pathStarts)
  
  pathEnds <- sapply(pathSplit, function(pathParts) {
    if(length(pathParts) <= 1) return("")
    paste0(pathParts[2:length(pathParts)],collapse="/")
  })
  
  splitLengths <- sapply(pathSplit,length)
  stillToParse <- unique(pathStarts[splitLengths > 1])
  
  endedIndices <- pathEnds == ""
  endedHere <- pathStarts[endedIndices]
  endedHere <- setdiff(endedHere,stillToParse)
  
  if(length(endedHere)) {
    pathEnds <- pathEnds[!endedIndices]
    pathStarts <- pathStarts[!endedIndices]
    uniquePathStarts <- unique(pathStarts)
    return(c(
      setNames(as.list(rep(1,length(endedHere))),endedHere),
      setNames(lapply(uniquePathStarts, function(ps) {
        pathsToNestedList(pathEnds[pathStarts == ps])
      }),uniquePathStarts)
    ))
  } else {
    return(
      setNames(lapply(uniquePathStarts, function(ps) {
        pathsToNestedList(pathEnds[!endedIndices & (pathStarts == ps)])
      }),uniquePathStarts))
  }
}

注意:我根据您更新的问题更新了我的答案。
更新:该功能可以简化为:

pathsToNestedList <- function(x) {
  nonNaIndices <- !is.na(x)
  nonEmptyIndices <- x != ""
  x <- x[nonNaIndices & nonEmptyIndices]
  if(!length(x)) return()
  
  pathSplit <- strsplit(x,"/")
  pathStarts <- sapply(pathSplit,"[[",1)
  
  pathEnds <- sapply(pathSplit, function(pathParts) {
    if(length(pathParts) <= 1) return("")
    paste0(pathParts[2:length(pathParts)],collapse="/")
  })
  
  splitLengths <- sapply(pathSplit,length)
  stillToParse <- unique(pathStarts[splitLengths > 1])
  
  endedIndices <- pathEnds == ""
  endedHere <- pathStarts[endedIndices]
  endedHere <- setdiff(endedHere,stillToParse)
  
  pathEnds <- pathEnds[!endedIndices]
  pathStarts <- pathStarts[!endedIndices]
  uniquePathStarts <- unique(pathStarts)
  
  #Concatenate the list of paths that ended with a list that is parsed again.
  #If one of those lists is empty, the concatenation behaves like
  #one would expect: It does nothing.
  return(
    c(setNames(as.list(rep(1,length(endedHere))),endedHere),
      setNames(lapply(uniquePathStarts, function(ps) {
        pathsToNestedList(pathEnds[pathStarts == ps])
      }),uniquePathStarts)
    )
  )
}

此外，我认识到它与 NA 一起崩溃了。和空字符串。因此我在函数的开头添加了一个删除部分。