R visNetwork shiny: change color of selected node

Question

I have a very simple problem given. I want to display an interactive network with visNetwork and when I click on a node, I want the color to change (the color is predefined).

I wanted to do this via observeEvent, but somehow it doesn't work. In fact, when I add the observeEvent part in the code below, I cannot click on any node anymore.

library(shiny); library(visNetwork); library(tidyverse); library(dplyr)

server <- function(input, output, session) {

  output$network_proxy_nodes <- renderVisNetwork({
    nodes <- data.frame(id = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))
    visNetwork(nodes, edges) %>%
      visNodes(color = "blue") %>%
      visEvents(click="function(nodes){
                Shiny.onInputChange('current_node_id',
                nodes);
  }")
  })

  changeColorOfSelectedNode <- function(nodes, selected.node){
    nodes %>%
      mutate(color = if_else(id == selected.node,
                             "red",
                             color))
  }

  observeEvent(input$current_node_id,
               {
                 simulation_nodes <- nodes %>%
                  changeColorOfSelectedNode(input$current_node_id$nodes[[1]])

                 visNetworkProxy("network_proxy_nodes") %>%
                  visUpdateNodes(nodes = simulation_nodes)
               })

}

ui <- fluidPage(
  visNetworkOutput("network_proxy_nodes")
)

shinyApp(ui=ui, server =server)

I am new to this kind of interactive visualization stuff with R and so maybe the error is trivial. Can you help me out?

Answer 1

Here is a way how to do it with observe:

library(shiny)
library(visNetwork)
library(tidyverse)

nodes <- data_frame(id = 1:3, color = rep("blue", 3))
edges <- data_frame(from = c(1, 2), to = c(1, 3))

server <- function(input, output, session) {
  output$network <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visOptions(nodesIdSelection = list(enabled = TRUE))
  })

  changeColorOfSelectedNode <- function(nodes, selected.node) {
    nodes %>% mutate(color = if_else(id == selected.node, "red", color))
  }

  observe({
    if (!is.null(input$network_selected) && input$network_selected > 0) {
      nodes <- changeColorOfSelectedNode(nodes, input$network_selected)
      visNetworkProxy("network") %>% visUpdateNodes(nodes)
    }
  })

}

ui <- fluidPage(visNetworkOutput("network"))

shinyApp(ui = ui, server = server)

Answer 2

This could be done without observeEvent since color of visNodes takes a paramater highlight that refers to the color of the selected node.

Updated Code:

library(shiny); library(visNetwork); library(tidyverse); library(dplyr);

server <- function(input, output, session) {

  output$network_proxy_nodes <- renderVisNetwork({
    nodes <- data.frame(id = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))
    visNetwork(nodes, edges) %>%
      visNodes(color = list(background = "blue", highlight = 'red')) %>%
      visEvents(click="function(nodes){
                Shiny.onInputChange('current_node_id',
                nodes);
  }")
  })

}

ui <- fluidPage(
  visNetworkOutput("network_proxy_nodes")
)

shinyApp(ui=ui, server =server)