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

这是使用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

这可以在没有observeEvent 的情况下完成，因为visNodes 的color 采用了一个参数highlight，它指的是所选节点的颜色。

更新代码：

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)