Change color of nodes in a group dynamically

[anujgupta1104]

I want to change color of nodes when i click a action button in Shiny

[bthieurmel]

Hi,

You can use visNetworkProxy with all functions. This is an example with group :

require(visNetwork)
require(shiny)

# Define the UI
ui <- bootstrapPage(
  visNetworkOutput("network"), 
  actionButton("update_group_color", "Update color")
)

# Define the server code
server <- function(input, output) {
  output$network <- renderVisNetwork({
    nodes <- data.frame(id = 1:10, label = paste("Label", 1:10), 
                        group = sample(c("A", "B"), 10, replace = TRUE))
    edges <- data.frame(from = c(2,5,10), to = c(1,2,10))

    visNetwork(nodes, edges) %>%
      visGroups(groupname = "A", color = "red", shape = "database") %>%
      visGroups(groupname = "B", color = "yellow", shape = "triangle")

  })

  observeEvent(input$update_group_color, {
    visNetworkProxy("network") %>% visGroups(groupname = "B", color = "green")
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

You can find more information with ?visNetworkProxy and shiny::runApp(system.file("shiny", package = "visNetwork"))

[anujgupta1104]

Thanks for the quick response, but it does not works when i use highlightNearest and nodesIdSelection visoptions. once i click on any node the above code does not works. even after deselecting the node the color of the nodes will not change.

[anujgupta1104]

look at the below code, it does not works once you click on the node. it can be the issue because i am using icon.

require(visNetwork) require(shiny)

Define the UI

ui <- bootstrapPage( visNetworkOutput("network"), actionButton("update_group_color_g", "Update color to green"), actionButton("update_group_color_y", "Update color to yellow") )

Define the server code

server <- function(input, output) { output$network <- renderVisNetwork({ nodes <- data.frame(id = 1:10, label = paste("Label", 1:10), group = sample(c("A", "B"), 10, replace = TRUE)) edges <- data.frame(from = c(2,5,10), to = c(1,2,10))

visNetwork(nodes, edges) %>%
  visOptions(highlightNearest = list(enabled = TRUE,degree=list(from=1,to=1),algorithm = "hierarchical"),
             nodesIdSelection = list(enabled = TRUE,main="Servers",style='visibility:hidden;')) %>%
  visGroups(groupname = "A",shape = "icon",icon = list(code = "f108",color = "red")) %>%
  visGroups(groupname = "B", shape = "icon",icon = list(code = "f108",color = "yellow")) %>%
  addFontAwesome()

})

observeEvent(input$update_group_color_g, { visNetworkProxy("network") %>% visGroups(groupname = "B",shape = "icon", icon = list(color = "green")) })

observeEvent(input$update_group_color_y, { visNetworkProxy("network") %>% visGroups(groupname = "B", shape = "icon", icon = list(color = "yellow")) }) }

Return a Shiny app object

shinyApp(ui = ui, server = server)

[bthieurmel]

Yes, it seems there is some bugs in using groups directly. You can fix updating nodes rather groups, like this :

require(visNetwork)
require(shiny)

# Define the UI
ui <- bootstrapPage(
  visNetworkOutput("network"),
  actionButton("update_group_color_g", "Update color to green"),
  actionButton("update_group_color_y", "Update color to yellow")
)

nodes <- data.frame(id = 1:10, label = paste("Label", 1:10),
                    group = sample(c("A", "B"), 10, replace = TRUE))

# Define the server code
server <- function(input, output) {
  output$network <- renderVisNetwork({
    edges <- data.frame(from = c(2,5,10), to = c(1,2,10))

    visNetwork(nodes, edges) %>%
      visOptions(highlightNearest = list(enabled = TRUE,degree=list(from=1,to=1),algorithm = "hierarchical"),
                 nodesIdSelection = list(enabled = TRUE,main="Servers",style='visibility:hidden;')) %>%
      visGroups(groupname = "A",shape = "icon",icon = list(code = "f108",color = "red")) %>%
      visGroups(groupname = "B", shape = "icon",icon = list(code = "f108",color = "yellow")) %>%
      addFontAwesome()
  })

  observeEvent(input$update_group_color_g, {
    update_nodes <- nodes[nodes$group== "B", c("id"), drop = FALSE]
    update_nodes$icon.color = "green"
    visNetworkProxy("network") %>% visUpdateNodes(update_nodes, updateOptions = FALSE)
  })

  observeEvent(input$update_group_color_y, {
    update_nodes <- nodes[nodes$group== "B", c("id"), drop = FALSE]
    update_nodes$icon.color = "yellow"
    visNetworkProxy("network") %>% visUpdateNodes(update_nodes, updateOptions = FALSE)
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)