CODEWITHSUNDEEP
javascriptrshinyrstudiovisnetwork
MMAASS
MMAASS

Reputation: 433

How to use visNetworkProxy in Shiny to interact with Nodes based on Nodes ids

I am building a network analysis in Shiny app.

I want to use the visNetworkProxy function to interact (focus/select) nodes based on nodes ids.

However, "nodes$id" in selectInput in UI has to be pre-defined. In this case, I have to define nodes&edges outside of server instead of inside of server.

Due to the nature of my project, I have to keep nodes & edges defined in the server to keep them updated with the database.

Below is my code: 

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

    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observe({
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observe({
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green")),
      selectInput("Focus", "Focus on node :",
                  nodes$id)
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px")
    )
  )
)

shinyApp(ui = ui, server = server)

I am wondering if there is a way to interact with nodes with nodes$id while keep nodes and edges inside the server.

Thanks in advance!

Upvotes: 2

Views: 1646

Answers (1)

JohnCoene
JohnCoene

Reputation: 2261

Here is something that'll work. You need to dynamically render the selectInput based on the nodes.

library(shiny)

 server <- function(input, output) {

  # minimal example
  nodes <- data.frame(id = 1:3)
  edges <- data.frame(from = c(1,2), to = c(1,3))

  output$network_proxy_nodes <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observeEvent(input$Focus, {
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observeEvent(input$color, {
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

  output$choose_node <- renderUI({
    selectInput("Focus", "Focus on node :",
                nodes$id)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green"))
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px"),
      uiOutput("choose_node")
    )
  )
)

shinyApp(ui = ui, server = server)

EDIT

Following your comment, adding a button.

library(shiny)

 server <- function(input, output) {

  # minimal example
  nodes <- data.frame(id = 1:3)
  edges <- data.frame(from = c(1,2), to = c(1,3))

  output$network_proxy_nodes <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observeEvent(input$focus_now, {
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observeEvent(input$color, {
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

  output$choose_node <- renderUI({
    selectInput("Focus", "Focus on node :",
                nodes$id)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green"))
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px"),
      uiOutput("choose_node"),
      actionButton("focus_now", "FOCUS")
    )
  )
)

shinyApp(ui = ui, server = server)

Upvotes: 1

Related Questions