如何将jsTree指定节点元素提取到R语言数据框中

运行可复现代码时，需要将基于jsTreeR包实现的jsTree中，用户拖拽复制到目标区域的节点提取到R数据框中，方便后续开展R运算操作。初始实现思路参考了基于sortable拖拽功能的同类元素提取方案，需求效果可参考文末示意图。
下方为初始测试代码，此前尝试实现提取逻辑的代码段已做注释标识：

library(jsTreeR)
library(shiny)

nodes <- list(
  list(
    text = "Menu",
    state = list(opened = TRUE),
    children = list(
      list(text = "A", type = "moveable", state = list(disabled = TRUE)),
      list(text = "B", type = "moveable", state = list(disabled = TRUE))
    )
  ),
  list(text = "Drag here:", 
       type = "target", 
       state = list(opened = TRUE)
  )
)

checkCallback <- JS(
  "function(operation, node, parent, position, more) { console.log(node);",
  "  if(operation === 'copy_node') {",
  "    if(parent.id === '#' || node.parent !== 'j1_1' || parent.type !== 'target') {",
  "      return false;",
  "    }",
  "  }",
  "  return true;",
  "}"
)
  
dnd <- list(
  always_copy = TRUE,
  is_draggable = JS(
    "function(node) {",
    "  return node[0].type === 'moveable';",
    "}"
  )
)

ui <- fluidPage(
  tags$head(
    tags$script(
      HTML(
        script <- 
          '
            $(document).ready(function(){
              $("#mytree").on("copy_node.jstree", function(e, data){
                var instance = data.new_instance;
                var node = data.node;
                var id = node.id;
                var text = node.text;
                var index = $("#"+id).index() + 1;
                instance.rename_node(node, index + ". " + text);
              })
            });
          '
      )
    )
  ),
  
  jstreeOutput("mytree"),
  # tableOutput("table1")
  
)  

server <- function(input, output){
  output[["mytree"]] <- renderJstree({
    jstree(
      nodes, 
      dragAndDrop = TRUE, 
      dnd = dnd, 
      checkCallback = checkCallback,
      types = list(moveable = list(), 
                   target = list()),
    )
  })

  # draggedElements <- reactive({
  #   data.frame(data = paste0(seq_along(jstreeOutput("mytree")), ". ", jstreeOutput("mytree")))
  # })
  
  # output$table1 <- renderTable({draggedElements()})
  
}  

shinyApp(ui, server)

jsTreeR渲染的树组件会自动将全量节点结构同步到Shiny的input对象中，不需要额外编写JS手动抓取元素，只需要写简单的递归函数提取目标容器下的子节点即可，核心逻辑如下：

• 编写递归遍历函数，遍历整棵树的节点，找到type为target的拖拽目标容器
• 提取该容器下所有子节点的文本、原始值等字段，转为数据框格式
• 微调原有JS逻辑，节点重命名后触发组件状态同步，保证R端拿到的文本和前端显示一致
• 渲染提取结果表格，验证数据正确性

修正后的完整可运行代码：

library(jsTreeR)
library(shiny)

# 递归提取目标节点下所有子节点的工具函数
extract_target_children <- function(tree_nodes, target_type = "target") {
  result <- list()
  for (node in tree_nodes) {
    if (!is.null(node$type) && node$type == target_type) {
      if (!is.null(node$children) && length(node$children) > 0) {
        result <- lapply(node$children, function(child) {
          data.frame(
            序号 = which(sapply(node$children, function(x) x$id == child$id)),
            节点文本 = child$text,
            原始值 = gsub("^\\d+\\.\\s", "", child$text),
            stringsAsFactors = FALSE
          )
        })
      }
      break
    }
    if (!is.null(node$children) && length(node$children) > 0) {
      res <- extract_target_children(node$children, target_type)
      if (length(res) > 0) {
        result <- res
        break
      }
    }
  }
  if (length(result) == 0) return(data.frame(序号 = integer(), 节点文本 = character(), 原始值 = character()))
  do.call(rbind, result)
}

nodes <- list(
  list(
    text = "Menu",
    state = list(opened = TRUE),
    children = list(
      list(text = "A", type = "moveable", state = list(disabled = TRUE)),
      list(text = "B", type = "moveable", state = list(disabled = TRUE))
    )
  ),
  list(text = "Drag here:", 
       type = "target", 
       state = list(opened = TRUE)
  )
)

checkCallback <- JS(
  "function(operation, node, parent, position, more) {",
  "  if(operation === 'copy_node') {",
  "    if(parent.id === '#' || node.parent !== 'j1_1' || parent.type !== 'target') {",
  "      return false;",
  "    }",
  "  }",
  "  return true;",
  "}"
)
  
dnd <- list(
  always_copy = TRUE,
  is_draggable = JS(
    "function(node) {",
    "  return node[0].type === 'moveable';",
    "}"
  )
)

ui <- fluidPage(
  tags$head(
    tags$script(
      HTML(
        '
          $(document).ready(function(){
            $("#mytree").on("copy_node.jstree rename_node.jstree", function(e, data){
              if(e.type === "copy_node"){
                var instance = data.new_instance;
                var node = data.node;
                var id = node.id;
                var text = node.text;
                var index = $("#"+id).index() + 1;
                instance.rename_node(node, index + ". " + text);
              }
              // 重命名后触发状态同步到R端
              Shiny.setInputValue("mytree", $("#mytree").jstree(true).get_json(null, {flat: false}));
            });
          });
        '
      )
    )
  ),
  jstreeOutput("mytree"),
  h4("拖拽提取结果："),
  tableOutput("table1")
)  

server <- function(input, output){
  output[["mytree"]] <- renderJstree({
    jstree(
      nodes, 
      dragAndDrop = TRUE, 
      dnd = dnd, 
      checkCallback = checkCallback,
      types = list(moveable = list(), target = list())
    )
  })

  draggedElements <- reactive({
    req(input$mytree)
    extract_target_children(input$mytree)
  })
  
  output$table1 <- renderTable({draggedElements()})
  
}  

shinyApp(ui, server)

运行代码后，将左侧可拖拽的A、B节点拖到右侧“Drag here:”区域，下方会自动实时更新表格，展示提取到的节点序号、显示文本、原始值，可直接用于后续R运算。

内容的提问来源于stack exchange，提问作者Curious Jorge - user9788072