1

我有一个非常简单的问题。我想用 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 的交互式可视化内容很陌生，所以错误可能是微不足道的。你能帮我吗？

4

2 回答 2

1

这可以在没有引用所选节点颜色的参数的情况observeEvent下完成。colorvisNodeshighlight

更新代码：

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)

在此处输入图像描述

于 2017-11-06T07:39:57.787 回答
0

这是一种方法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)
于 2017-11-15T20:17:50.870 回答