rshinyshinydashboardvisnetwork

Can I double click on a node in a visNetwork diagram to run a function?


I have a network diagram with a few nodes, each node having some data, including an ID and its name. I'm building the visNetwork object like this:

getDiagramPlot <- function(nodes, edges){
  v <- visNetwork(
    nodes, 
    edges
  ) %>%
    visPhysics(stabilization = TRUE, enabled = TRUE) %>%
    visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
    visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
    visLayout(improvedLayout = TRUE) %>%
    visEdges(arrows = edges$arrows) %>%
    visInteraction(multiselect = F)
  return(v)
}

What I'm after is being able to pipe in visEvents and call a function in my code, ideally passing the ID as a parameter. Something like:

testFunction <- function(node_id){
  print(paste("The selected node ID is:", node_id))
}

The examples I've seen online are mostly using the javascript alert() in their examples, but I'm looking to break out of javascript and call an R function in my code.

Any help with this would be much appreciated! Thank you in advance.


Solution

  • You can use Shiny.onInputChange in javascript to set anything as a Shiny input variable. This does the trick.

    EDIT: Use doubleClick in visEvents to trigger the code on double click. See https://rdrr.io/cran/visNetwork/man/visEvents.html

    library(shiny)
    library(visNetwork)
    ui <- fluidPage(
      visNetworkOutput('network')
    )
    
    server <- function(input, output, session) {
      getDiagramPlot <- function(nodes, edges){
        v <- visNetwork(
          nodes, 
          edges
        ) %>%
          visPhysics(stabilization = TRUE, enabled = TRUE) %>%
          visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
          visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
          visLayout(improvedLayout = TRUE) %>%
          visEdges(arrows = edges$arrows) %>%
          visInteraction(multiselect = F) %>%
          visEvents(doubleClick = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
        return(v)
      }
    
      testFunction <- function(node_id){
        print(paste("The selected node ID is:", node_id))
      }
    
      nodes <- data.frame(id = 1:3, label = 1:3)
      edges <- data.frame(from = c(1,2), to = c(1,3))
    
      output$network <- renderVisNetwork(
        getDiagramPlot(nodes, edges)
      )
    
      observeEvent(input$current_node_id,{
        testFunction(input$current_node_id)
        })
    }
    
    shinyApp(ui, server)