R visNetwork闪亮：更改所选节点的颜色

Question

我有一个非常简单的问题。 我想显示一个使用visNetwork的交互式网络，当我单击一个节点时，我希望颜色改变（颜色是预定义的）。

我想通过observeEvent来做到这一点，但是不知何故。 实际上，当我在下面的代码中添加observeEvent部分时，我无法再单击任何节点。

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)

我是使用R进行这种交互式可视化工作的新手，所以也许错误不大。 你能帮我吗？

Answer 1

由于observeEvent color采用了一个visNodes highlight ，该highlight指的是选定节点的颜色，因此可以在没有observeEvent情况下完成此操作。

更新的代码：

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)

Answer 2

这是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)