CODEWITHSUNDEEP
rshinyshinydashboardvisnetwork
bhft
bhft

Reputation: 13

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.

Upvotes: 1

Views: 971

Answers (1)

Muzammil Aziz
Muzammil Aziz

Reputation: 186

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)

Upvotes: 1

Related Questions