Search code examples
rshinyrstudiovisnetwork

How to show Shiny input of nodes and edges from visNetwork together instead of separate


I am building a network in Shiny using visNetwork package.

The function of showing nodes and edges input is interesting. However, nodes and edges input can only be shown separately instead of together in 1 box.

I followed the following instruction https://datastorm-open.github.io/visNetwork/shiny.html to build the interactive nodes and edges input by hovering over the nodes and edges. This is done by using hoverNode/hoverEdge arg in visEvent function in visNetwork package. This is based on Shiny.OnInputChange function in javascript event

library(visNetwork)
library(shiny)

server <- function(input, output) {
  output$network <- renderVisNetwork({
    # minimal example
    nodes <- data.frame(id = 1:3, label = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))

    visNetwork(nodes, edges) %>%
      visInteraction(hover = TRUE) %>%
      visEvents(hoverNode = "function(nodes) {
        Shiny.onInputChange('current_node_id', nodes);
      ;}"), hoverEdge = "function(edges) {
        Shiny.onInputChange('current_edge_id', edges);
      ;}")
  })

  output$shiny_return <- renderPrint({
    input$current_node_id
  })
}

  output$shiny_return <- renderPrint({
    input$current_edge_id
  })
}

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

shinyApp(ui = ui, server = server)

Based on the code, I have 2 renderPrint output. I want to keep for 1, however, it is restricted by hoverNode/hoverEdge arguments .

Thanks in advance


Solution

  • Shiny.onInputChange allows us to specify any name for the output. Since at any given time you can hover over either a node or an edge you can simply give both the nodes and edges the same name in the JS code, and refer to this input on the Shiny server-side code. This is what it would look like:

    library(visNetwork)
    library(shiny)
    
    server <- function(input, output) {
      output$network <- renderVisNetwork({
        # minimal example
        nodes <- data.frame(id = 1:3, label = 1:3)
        edges <- data.frame(from = c(1,2), to = c(1,3))
    
        visNetwork(nodes, edges) %>%
          visInteraction(hover = TRUE) %>%
          visEvents(hoverNode = "function(nodes) {
                    Shiny.onInputChange('unique_id', nodes);
                    ;}", hoverEdge = "function(edges) {
        Shiny.onInputChange('unique_id', edges);
        ;}")
      })
    
      output$shiny_return <- renderPrint({
        input$unique_id
      })
    }
    
    ui <- fluidPage(
      visNetworkOutput("network"),
      verbatimTextOutput("shiny_return")
    )
    
    shinyApp(ui = ui, server = server)