在 r Shiny 中撤消 Visnetwork 中的单击事件

Question

我在 Shiny 中创建了一个网络图，并希望在网络图下方显示所选节点的详细信息。此链接上标记为正确的答案帮助我实现了这一目标。

Click events for VisNetwork with Shiny

我想做的另一件事是，当用户单击网络图中的其他任何位置（空白区域）时，先前单击的节点的信息也应该以与取消选择所选节点相同的方式消失。

如果可能，请提出建议。下面是代码

library(shiny)
library(visNetwork)

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)

Answer 1

是的，你可以。诀窍是将另一个变量传递给 R，以告诉您是单击节点还是画布。如果您在画布上单击，那么node.node 应该是undefined。将该信息存储在一个变量中，将其传递给 R，并相应地（或不）显示节点信息。

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]);
                Shiny.onInputChange('node_selected', nodes.nodes.length);
                ;}"
      ) 
  })

  output$shiny_return <- renderPrint({
    if (!is.null(input$node_selected) && (input$node_selected == 1)) {
    visNetworkProxy("network") %>%
      visNearestNodes(target = input$click)
    } else {
      invisible()
    }
  })
} 

编辑：回复评论

observe({
  input$node_selected 
  input$click
    if(!is.null(input$node_selected) && (input$node_selected == 1)){ 
      output$networkTable <- renderDataTable(data.frame(x = runif(10), 
                                                        y = runif(10))) 
    } else { 
      output$networkTable <- renderDataTable(NULL)
    } 
})