VisNetwork click event is not working when the code is moved into a module

shiny
1

Hi,
I am working on a shiny R application using visNetwork visualization. My code base was getting large so I decided to indulge with Modules. On the surface things work great but my click event is not working the way it was working when my code was in ui.R and server.R
Here's the code to reproduce the error -
I need the node label id to be shown in "click_ui"
Here's the module code

library('shiny')
library('dplyr')
library('visNetwork')
library('igraph')


#Ui code
ui <- fluidPage(
 
  tabPanel( "NetworkDiagram", networkdiagramModuleUI("NetworkDiagram"))
  
)
#server code
server <- function(input, output, session) {
  callModule(networkdiagramModule,"NetworkDiagram")
}
#module UI code
networkdiagramModuleUI <- function(id)
{
  ns <- NS(id)
  tagList(
    
     fluidRow(style = "margin-left: 30px;margin-bottom: 30px; width=100%; height=900px"
             ,column(12, uiOutput(ns("click_ui"),  height = 800) )
             ,column(12, visNetworkOutput(ns("Network_plot"),  height = 800) )
             
    )
    
  )
}


#module server code


networkdiagramModule <- function(input,output,session)
{
  nodes <- data.frame(id = 1:10, 
                      label = paste("Node", 1:10),                                 # add labels on nodes
                      group = c("GrA", "GrB"),                                     # add groups on nodes 
                      value = 1:10,                                                # size adding value
                      shape = c("square", "triangle", "box", "circle", "dot", "star",
                                "ellipse", "database", "text", "diamond"),                   # control shape of nodes
                      title = paste0("<p><b>", 1:10,"</b><br>Node !</p>"),         # tooltip (html or character)
                      color = c("darkred", "grey", "orange", "darkblue", "purple"),# color
                      shadow = c(FALSE, TRUE, FALSE, TRUE, TRUE))     
  edges <- data.frame(from = sample(1:10, 8), to = sample(1:10, 8),
                      label = paste("Edge", 1:8),                                 # add labels on edges
                      length = c(100,500),                                        # length
                      arrows = c("to", "from", "middle", "middle;to"),            # arrows
                      dashes = c(TRUE, FALSE),                                    # dashes
                      title = paste("Edge", 1:8),                                 # tooltip (html or character)
                      smooth = c(FALSE, TRUE),                                    # smooth
                      shadow = c(FALSE, TRUE, FALSE, TRUE))                       # shadow
  output$Network_plot <- renderVisNetwork({
    visNetwork(nodes, edges, width = "100%") %>%
      visIgraphLayout() %>%
      visEvents(click="function(ng_nodes){
                       Shiny.onInputChange('got_network_current_node_id',ng_nodes);}")
  })
  
  output$click_ui <- renderUI({
    if (is.null(input$got_network_current_node_id) )
    {
      paste0("No node has been clicked, yet", countn, sep='_')
    }
    else
    {
      if (length(input$got_network_current_node_id$node) == 0)
      {
        "You have clicked within the visNetwork but not on a node"
      }
      else
      {
        nodeid <- input$got_network_current_node_id$nodes
        tempnodeid <-unlist(nodeid)
        nodedata = subset(ng_nodes, (ng_nodes$id %in% tempnodeid))
        x<-as.character(nodedata$label)
        
        print(paste0("Selected Nodes:",paste(unlist(x), collapse = ", ")))
      }
    }
    countn = 'test20'
  })
  
}

I would appreciate any help.
Thanks
Sukhwant

2

Hi, try this:
Use ns arround the javascript call

networkdiagramModule <- function(input,output,session)
{
ns <- session$ns
...

visEvents(click=paste0("function(ng_nodes){
Shiny.onInputChange('",ns(got_network_current_node_id),"',ng_nodes);}"))
...

})

3

Thanks for taking the time to suggest this solution but it didn't work :(. Do you have any working sample?
Thanks
Sukhwant

4

Hi, I managed to make the code below to work. You need to put the ns() function wrapping the id of the object called in your javascript. I had to modify few more lines because of the error on "nodedata = subset(....)" line.
I hope it solves your problem:

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library('shiny')
library('dplyr')
library('visNetwork')
library('igraph')

#module UI code
networkdiagramModuleUI <- function(id)
{
  ns <- NS(id)
  tagList(
    
    fluidRow(style = "margin-left: 30px;margin-bottom: 30px; width=100%; height=900px"
             ,column(12, uiOutput(ns("click_ui"),  height = 800) )
             ,column(12, visNetworkOutput(ns("Network_plot"),  height = 800) )
             
    )
    
  )
}

networkdiagramModule <- function(input,output,session)
{
  ns <- session$ns
  nodes <- data.frame(id = 1:10, 
                      label = paste("Node", 1:10),                                 # add labels on nodes
                      group = c("GrA", "GrB"),                                     # add groups on nodes 
                      value = 1:10,                                                # size adding value
                      shape = c("square", "triangle", "box", "circle", "dot", "star",
                                "ellipse", "database", "text", "diamond"),                   # control shape of nodes
                      title = paste0("<p><b>", 1:10,"</b><br>Node !</p>"),         # tooltip (html or character)
                      color = c("darkred", "grey", "orange", "darkblue", "purple"),# color
                      shadow = c(FALSE, TRUE, FALSE, TRUE, TRUE))     
  edges <- data.frame(from = sample(1:10, 8), to = sample(1:10, 8),
                      label = paste("Edge", 1:8),                                 # add labels on edges
                      length = c(100,500),                                        # length
                      arrows = c("to", "from", "middle", "middle;to"),            # arrows
                      dashes = c(TRUE, FALSE),                                    # dashes
                      title = paste("Edge", 1:8),                                 # tooltip (html or character)
                      smooth = c(FALSE, TRUE),                                    # smooth
                      shadow = c(FALSE, TRUE, FALSE, TRUE))                       # shadow
  output$Network_plot <- renderVisNetwork({
    visNetwork(nodes, edges, width = "100%") %>%
      visIgraphLayout() %>%
      visEvents(click=paste0("function(ng_nodes){
                console.log('teste');
                Shiny.onInputChange('",ns('got_network_current_node_id'),"',ng_nodes.nodes[0]);
                             }"))
  })
    
  output$click_ui <- renderUI({
    print(input$got_network_current_node_id)
    
    if (is.null(input$got_network_current_node_id) )
    {
      countn = ''
      paste0("No node has been clicked, yet", countn, sep='_')
    }
    else
    {
      if (length(input$got_network_current_node_id) == 0)
      {
        "You have clicked within the visNetwork but not on a node"
      }
      else
      {
        
        nodeid <- input$got_network_current_node_id
        #tempnodeid <-unlist(nodeid)
        #nodedata = subset(ng_nodes, (ng_nodes$id %in% tempnodeid))
        #x<-as.character(nodedata$label)
        x <- as.character(nodeid)
        
        print(paste0("Selected Nodes:",paste(unlist(x), collapse = ", ")))
      }
    }
    countn = 'test20'
  })
  
}


# Define UI for application that draws a histogram
ui <- fluidPage(
  
  tabPanel( "NetworkDiagram2", networkdiagramModuleUI("NetworkDiagram"))
  
)
#server code
server <- function(input, output, session) {
  callModule(networkdiagramModule,"NetworkDiagram")
}




# Run the application 
shinyApp(ui = ui, server = server)
1 Like
5

Hi Andrepignata,
You are awsome :slight_smile: It worked.
sukhwant

2 Likes