在r闪亮中撤消Visnetwork中的单击事件

时间:2018-04-19 05:59:49

标签: r graph shiny vis.js visnetwork

我在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)

1 个答案:

答案 0 :(得分: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)
    } 
})