r - VisNetwork with Shiny 的点击事件

Question

我已经使用 Shiny 中的 visNetwork 包构建了我的网络。我想单击一个节点，然后从数据框中显示有关该节点的信息。我已经能够使用单击和近点函数对散点图执行此操作，例如此处显示的 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仅用于 plotOuput。不能与 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)