根据闪亮应用中的网络边缘选择更新数据表

时间:2018-11-05 22:01:36

标签: r shiny visnetwork

我有一个简单的闪亮应用程序,它基于以下数据集显示一个小型网络。正如您将看到的,当用户单击节点时,将看到一张包含该节点连接的表格。为此,我使用了

visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")

但是我不能使它在边缘选择方面同样起作用,以便使第二个数据表使用类似以下内容来显示与所选边缘相关的所有连接:

visEvents(select = "function(edges) {
                    Shiny.onInputChange('current_edge_id', edges.edges);
                    ;}")

APP

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')),
        column(width = 6,
               visNetworkOutput("network")) #note that column widths in a fluidRow should sum to 12
      ),
      fluidRow(column(width = 6), 
               column(width=6, "Click and hold nodes for a second to select additional nodes.")
      )

    ) #end of fluidPage


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

      output$network <- renderVisNetwork({
        visNetwork(nodes = node,edges=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);
                    ;}")

      })

      #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)

0 个答案:

没有答案