How can I interactively filter nodes/edges from a visNetwork using checkboxes? (using R Shiny)

user_9530011 0
Viewed 369

Using the Shiny and visNetwork R packages I have created an interactive network visualisation. I would like to enable users to remove/add nodes and edges by using checkboxes in the UI. I managed to get this working partially, but somehow my solution does not work when multiple items are filtered.

An example of the behaviour I am trying to achieve can be viewed here.

Please find my code below.

library(visNetwork)
library(shiny)
library(dplyr)

nodes <- data.frame("id" = 1:6)
edges <- data.frame("id" = 1:4, "to" = c(1,2,4,5), "from" = c(2,3,5,6))

ui <- fluidPage(title = "example",
                fillPage(
                  sidebarLayout(
                    sidebarPanel(
                      checkboxGroupInput(inputId = "filterNodes", 
                                         label = "Select nodes:", 
                                         choices = nodes$id, 
                                         selected = nodes$id),
    
                      width = 3),
                    mainPanel(
                      visNetworkOutput("network_proxy_update",width = "100%", height = "90vh"),
                      width = 9)
                  )
                  
                )
)

server <- function(input, output) {

  
  output$network_proxy_update <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes (color = "blue")
  })
  
  observe ({
  
    filteredNodes <- data.frame("id" = nodes[nodes$id %in% input$filterNodes, "id"])
    hiddenNodes <- anti_join(nodes, filteredNodes)
    
    
    visNetworkProxy("network_proxy_update") %>%
      visRemoveNodes(id = hiddenNodes) %>%
      visUpdateNodes(nodes = filteredNodes)
      
  })
}

shinyApp(ui = ui, server = server)

Any help would be greatly appreciated. Best regards, Tim

visnetwork shiny r
1 Answers

visRemoveNodes expects a vector of id's while visUpdateNodes needs a data.frame of nodes:

library(visNetwork)
library(shiny)
library(dplyr)

nodes <- data.frame("id" = 1:6)
edges <- data.frame(
  "id" = 1:4,
  "to" = c(1, 2, 4, 5),
  "from" = c(2, 3, 5, 6)
)

ui <- fluidPage(title = "example",
                fillPage(sidebarLayout(
                  sidebarPanel(
                    checkboxGroupInput(
                      inputId = "filterNodes",
                      label = "Select nodes:",
                      choices = nodes$id,
                      selected = nodes$id
                    ),
                    width = 3
                  ),
                  mainPanel(
                    visNetworkOutput("network_proxy_update", width = "100%", height = "90vh"),
                    width = 9
                  )
                )))

server <- function(input, output) {
  output$network_proxy_update <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes (color = "blue")
  })
  
  myVisNetworkProxy <- visNetworkProxy("network_proxy_update")
  
  observe ({
    filteredNodes <- nodes[nodes$id %in% input$filterNodes, , drop = FALSE]
    hiddenNodes <- anti_join(nodes, filteredNodes)
    visRemoveNodes(myVisNetworkProxy, id = hiddenNodes$id)
    visUpdateNodes(myVisNetworkProxy, nodes = filteredNodes)
  })
}

shinyApp(ui = ui, server = server)

result

user_98413890
Related