使用visNetwork

Question

我有一个简单的闪亮应用程序，它显示一个小的网络。如您所见，当我单击一个节点时，下面的数据表将相应地更新。问题是，当我从顶部的下拉列表中选择一个节点时，这不会发生，该节点是visnetwork提供的nodesIdSelection（）。是否可以创建具有与此下拉按钮完全相同的功能的selectInput()？这意味着当我单击一个节点时，selectInput()将仅在selectInput中显示所选的节点，并且当我从selectInput()的一个节点中选择一个节点时，将在网络中选择并显示该节点。在表中。

library(igraph)
library(visNetwork)
library(dplyr)
library(shiny)
library(shinythemes)
library(DT)

#dataset
id<-c("articaine","benzocaine","etho","esli")
label<-c("articaine","benzocaine","etho","esli")
node<-data.frame(id,label)

from<-c("articaine","articaine","articaine",
        "articaine","articaine","articaine",
        "articaine","articaine","articaine")
to<-c("benzocaine","etho","esli","benzocaine","etho","esli","benzocaine","etho","esli")
title<-c("SCN1A","SCN1A","SCN1A","SCN2A","SCN2A","SCN2A","SCN3A","SCN3A","SCN3A")

edge<-data.frame(from,to,title)


#app

ui <- fluidPage(

  # Generate Title Panel at the top of the app
  titlePanel("Network Visualization App"),

  fluidRow(
    column(width = 6,
           DTOutput('tbl'),
           uiOutput("sel")),
    column(width = 6,
           visNetworkOutput("network")) #note that column widths in a fluidRow should sum to 12
  )

) #end of fluidPage


server <- function (input, output, session){

  output$network <- renderVisNetwork({
    visNetwork(nodes = node,edge) %>% 
      visOptions(highlightNearest=TRUE, 
                 nodesIdSelection = TRUE) %>%
      #allow for long click to select additional nodes
      visInteraction(multiselect = TRUE) %>%
      visIgraphLayout() %>% 

      #Use visEvents to turn set input$current_node_selection to list of selected nodes
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_selection', nodes.nodes);
                ;}")

  })
  output$sel<-renderUI({
    selectInput("ids","Select ID", choices=unique(edge[,c(1,2)]))
  })
  #render data table restricted to selected nodes
  output$tbl <- renderDT(
    edge %>% 
      filter((to %in% input$current_node_selection)|(from %in% input$current_node_selection)),
    options = list(lengthChange = FALSE)
  )

}

shinyApp(ui, server)