ShinyR Application with module

shiny
1

Hi,
I am trying to get the click information out of my viz network which is inside a module. I just can't seam to get it to work - here's my code:

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);}"))%>%
                visInteraction(dragNodes = TRUE,dragView = TRUE,navigationButtons = TRUE,multiselect = TRUE, hover=TRUE)
                
    
  })
  
  vals <- reactiveValues(
  
  vals$myselection <- 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 = ", ")))
      }
    }
    
  })
  ) 
  return vals
}


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




# Run the application 
shinyApp(ui = ui, server = server)

I would appreciate any guidance.
Thanks
Sukhwant

2

You need to put your vals into a reactive. The return value from callModule is a reactive function, not a reactive value.

You could try this:

Replace

return vals

with

return(reactive({vals$myselection})

and

View(test)

with

View(test())
3

Hi stkrog,
Thanks for taking the time to write back. I tried what you suggested .. I am getting an error stating vals is not found. I am not sure if I am creating the reactive correctly. The code below works except the click event now... as I added the vals :frowning:

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);}")) %>%
      visInteraction(dragNodes = TRUE,dragView = TRUE,navigationButtons = TRUE,multiselect = TRUE, hover=TRUE)
  })
 
    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
      {
        vals <- reactiveValues(
          
          vals$myselection <- input$got_network_current_node_id
        )
        nodeid <- input$got_network_current_node_id
        
        x <- as.character(nodeid)
        
        print(paste0("Selected Nodes:",paste(unlist(x), collapse = ", ")))
      }
    }
   
  })
    #Taking the output$click_ui value and putting it in the myselection
    
  
  return(reactive({vals$myselection}))
  
}


# Define UI for application 
ui <- fluidPage(
  
  tabPanel( "NetworkDiagram2", networkdiagramModuleUI("NetworkDiagram"))
  
)
#server code
server <- function(input, output, session) {
  test = callModule(networkdiagramModule,"NetworkDiagram")
  View(test())
  
}




# Run the application 
shinyApp(ui = ui, server = server)
4

Hi sukhwantkaur,

It's a litte bit difficult to read your code when you do not use the code tags when you post. I can see that some of your code is in code tags while other is not. Please put all your code in code tags :slight_smile:

If I read your code correct you define vals inside the renderUI reactive. That means that it is not visible outside this reactive and that it will also go out of scope and be destroyed when you leave the reactive. Try define vals inside you module function but outside any sub-functions/reactives.

It also looks like you changed your logic from the first post. Now you want to return the content of input$got_network_current_node_id as vals$myselection, in the first post you returned output$click_ui (sort of)?

Cheers
Steen

1 Like
5

Hi Steen,
Thanks for writing back. I am still trying to grasp this reactive concept. Your guidance has been very helpful. Anyway here's what I have been trying to do - Building a network diagram which is about 6 or 7 level deep and it's becoming cluttered because it's too much data. So we thought we would create a diagram first with three level down. Third level has three colors red,yellow,green. User would most likely want to see what's going on with the red level so they will click on the red circle. At that point we want to show more features on the chart. That's why I was trying to read the the node id. My thought was that if I can capture the id from the module I can pass that id to my sql and rebuild my node and edges and reuse the module.
I don't know how to put the code in tags.. but will be more careful with that next time :slight_smile:
Thanks
Sukhwant

6

Hi Sukhwant,

You put things in code tags by clicking the </> icon in the top line of the editor. That will insert the code escapes (two lines with each three ' ). You can the put your code in between the tags.

Your program: If I understand correctly you have two outputs in your app (click_ui and Network_plot) and one input (got_network_current_node_id). You click_ui output just shows the content of input$got_network_current_node_id. output$Network_plot shows the vizNetwork output, and sets input$got_network_current_node_id upon a click event.

So ouput$Network_plot depends on your data, and your data depends on the content of input$got_network_current_node_id. output$clicl_ui depends on input$got_network_current_node_id, but I guess that is just for you to see the content?

I would put your data in a reactiveValue, and display that reactiveValue in output$Network_plot. Then I would use an observeEvent reactive to monitor the value of input$got_network_current_node_id, and update the data reactiveValue when input$got_network_current_node_id changes. This update will automatically invalidate output$Network_plot, as this output depends on the data reactiveValue.

So something in the lines of (this is all in your module funcion):

vals = reactiveValues()
vals$data = <initial data, not dependent on input$got_network_current_node_id>

output$Network_plot = renderVisNetwork({
  <some code where you construct the plot with data from vals$data>
})

observeEvent(input$got_network_current_node_id, {
  <some code where you update vals$data based on the current value of input$got_network_current_node_id>
})

You don't need to return anything from the module function, as the module is self-contained.

Hope this helps.
Steen

1 Like
7

Hi Steve,
Thanks a lot for your guidance.
Sukhwant