r - shinyTree - 一旦树展开就运行函数

Question

假设我有一个最小的工作示例，例如

library(shiny)
library(shinyTree)

ui <- fluidPage(
  shinyTree("tree", contextmenu = TRUE, search = TRUE, unique = TRUE, sort = TRUE)
)

server <- function(input, output, session) {
  
  output$tree <- renderTree({
    list(
      root1 = "",
      root2 = list(
        SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListB = list(leafA = "", leafB = "")
      ),
      root3 = list(
        SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListB = list(leafA = "", leafB = "")
      )
    )
  })
}

shinyApp(ui, server)

它生成一个shinyTree（jstree），如

如果我在展开树时单击左侧的一个小三角形（不一定要选择任何东西），是否可以运行函数。我正在考虑使用shinyjs带有 onclick 事件的包，但并没有真正管理那么多

标签： rshinyjstreeshinytree

Answer 1

你可以使用这些jstree 事件来触发一个闪亮的观察者来执行一个函数。在下面的例子中，JS 代码会用展开节点的名称更新 的值input$expanded_node，然后触发关联的观察者。

library(shiny)
library(shinyTree)

ui <- fluidPage(
  shinyTree("tree", contextmenu = TRUE, search = TRUE, unique = TRUE, sort = TRUE),
  tags$script(HTML('
    // "triggered when a node is opened and the animation is complete"
    $("#tree").on("after_open.jstree", function (e, data) {
      Shiny.onInputChange("expanded_node", data.node.text, {priority: "event"});
    });
  ')),
  verbatimTextOutput("function_result")
)

server <- function(input, output, session) {
  
  output$tree <- renderTree({
    list(
      root1 = "",
      root2 = list(
        SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListB = list(leafA = "", leafB = "")
      ),
      root3 = list(
        SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListB = list(leafA = "", leafB = "")
      )
    )
  })
  
  result <- reactiveValues()
  
  observeEvent(input$expanded_node, {
    # execute a function ...
    result$data <- runif(1, 1, 1e6)
    result$node <- input$expanded_node
  })
  
  output$function_result <- renderPrint({ 
    paste("Node:", result$node, ", Result:", result$data)
  })
}

shinyApp(ui, server)