闪亮的Visnetwork互动和事件

Question

我正在尝试为网络可视化创建交互式图例的效果。 理想情况下，我希望用户能够单击图例节点，并且它将在较大的网络图表中突出显示/聚焦。

我有一个类似的网络图表，我已经能够使用selectInput下拉列表使用下面的代码片段进行突出显示/聚焦操作，但是我不知道如何从另一个网络与selectInput传递值。

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

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

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)