Создайте selectInput () с той же функциональностью и списком nodeIdSelection () в visNetwork - PullRequest
Новая
       14

Создайте selectInput () с той же функциональностью и списком nodeIdSelection () в visNetwork

0 голосов
/ 05 ноября 2018

У меня есть простое блестящее приложение, которое отображает небольшую сеть. Как вы можете видеть, когда я нажимаю на узел, приведенные ниже данные обновляются соответственно. Проблема в том, что этого не происходит, когда я выбираю узел из выпадающего списка в верхней части, который visnetwork предоставляет с помощью nodeIdSelection (). Можно ли создать 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)
...