VisNetwork with Shiny 的点击事件

Question

我已经使用 Shiny 中的 visNetwork 包构建了我的网络。我想单击一个节点，然后从数据框中显示有关该节点的信息。我已经能够使用 click 和 nearpoint 函数对散点图执行此操作，例如此处显示的 Shiny 示例中的函数：http://shiny.rstudio.com/gallery/plot-interaction-selecting-points.html。

对于我的网络，我已经尝试过：

server <- function(input, output) {
output$network <- renderVisNetwork({
visNetwork(my.nodes, my.edges, 
           height = "100%", width = "100%",
           main = "") %>%
visEvents(hoverNode = "function(nodes){
            Shiny.onInputChange('current_node_id',nodes);
            ;}",
            click = "function(){
            Shiny.onInputChange('click',{node: current_node_id});
            ;}"
  )
})

output$shiny_return <- renderPrint({
if(!is.null(input$current_node_id)){
nearPoints(node.data,click$node, addDist = TRUE )    
}
})

ui <- fluidPage(
visNetworkOutput("network"), 
verbatimTextOutput("shiny_return")  
)

但是，我收到一条错误消息，提示“未找到点击对象”

感谢您的帮助。

Answer 1

不同点：

• 你的javascript事件click是错误的。不知道current_node_id，必须用input$click而不是click$node
• nearPoints 仅用于 plotOutput。不能与 javascript / htmlwidgets 函数一起使用。

要使用visNetwork 启用这种功能，我刚刚在最新的开发版本中添加了一个新功能visNearestNodes。这是一个简单的例子：

# install dev version
devtools::install_github("datastorm-open/visNetwork")

require(visNetwork)
require(shiny)

nodes <- data.frame(id = 1:15, label = paste("Label", 1:15),
                    group = sample(LETTERS[1:3], 15, replace = TRUE))

edges <- data.frame(from = trunc(runif(15)*(15-1))+1,
                    to = trunc(runif(15)*(15-1))+1)

server <- function(input, output, session) {
  output$network <- renderVisNetwork({
    visNetwork(nodes, edges, 
               height = "100%", width = "100%",
               main = "") %>%
      visEvents(click = "function(nodes){
                  Shiny.onInputChange('click', nodes.nodes[0]);
                  ;}"
      )
  })

  output$shiny_return <- renderPrint({
    visNetworkProxy("network") %>%
      visNearestNodes(target = input$click)
  })
}

ui <- fluidPage(
  visNetworkOutput("network"), 
  verbatimTextOutput("shiny_return")  
)

shiny::shinyApp(ui = ui, server = server)