闪亮的 Visnetwork 互动和活动

Question

我正在尝试为网络可视化创建交互式图例的效果。理想情况下，我希望用户能够单击图例节点，它会在较大的网络图表中 highlight/focus。

我有一个类似的网络图表我已经能够使用 selectInput 下拉菜单执行 highlight/focus 操作，使用类似下面的代码片段，但我不知道如何传递值来自另一个网络与 selectInput。

 observe({
    visNetworkProxy("vis_1") %>%
      visFocus(id = input$Focus, scale = 1)%>%
      visSelectNodes(id = input$Focus)
    #  visSetSelection(id = input$Focus, highlightEdges = TRUE)
  })

我的想法是创建两个网络图表（一个小的用作图例）和一个更大的整体网络。然后我可以单击图例并在较大图表中的组中归零。下面是创建第一部分（图例图表和网络图表）的示例数据......我不确定如何传递点击事件和相应的组。

library(shiny)
library(visNetwork)
library(DT)

server <- function(input, output, session) {
  ## data
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      group = c("info1", "info1", "info2"),
                      color = c("blue","blue","red"))
  edges <- data.frame(from = c(1,2), to = c(2,2), id = 1:2)

  ## data for legend network  
  nodesb <- data.frame(id = c("info1","info2"),
                       color = c("blue","red"))


  ##  network
  output$network_proxy1 <- renderVisNetwork({
    visNetwork(nodes, edges, main = "Network Chart") %>%
    visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
    })
  ## legend network
  output$network_proxy2 <- renderVisNetwork({
    visNetwork(nodesb, main = "Legend") %>%
    visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
    })



}

ui <- fluidPage(
  visNetworkOutput("network_proxy2", height = "100px"),
  visNetworkOutput("network_proxy1", height = "400px")
)

shinyApp(ui = ui, server = server)

Answer 1

你几乎成功了。您可以在服务器函数中引用 Shiny.onInputChange 值，将其视为任何其他输入。这是它的样子：

library(shiny)
library(visNetwork)
library(DT)
library(dplyr)

server <- function(input, output, session) {
  ## data
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      group = c("info1", "info1", "info2"),
                      color = c("blue","blue","red"))
  edges <- data.frame(from = c(1,2), to = c(2,2), id = 1:2)

  ## data for legend network  
  nodesb <- data.frame(id = c("info1","info2"),
                       color = c("blue","red"))


  ##  network
  output$network_proxy1 <- renderVisNetwork({
    visNetwork(nodes, edges, main = "Network Chart")
})
  ## legend network
  output$network_proxy2 <- renderVisNetwork({
    visNetwork(nodesb, main = "Legend") %>%
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id_legend', nodes.nodes);
                ;}")
})

  # Find the ID of the gorup selected and focus on the first element
  observe({

    id = nodes%>%
      filter(group %in% input$current_node_id_legend)%>%
      .$id%>%
      .[1]

    visNetworkProxy("network_proxy1") %>%
      visFocus(id = id, scale = 4)
  })

}

ui <- fluidPage(
  visNetworkOutput("network_proxy2", height = "100px"),
  visNetworkOutput("network_proxy1", height = "400px")
)

shinyApp(ui = ui, server = server)

闪亮的 Visnetwork 互动和活动

Shiny Visnetwork Interactions & Events

r

shiny

shiny-reactivity

visnetwork

react-vis-network