我有一个简单的闪亮应用程序,它基于以下数据集显示一个小型网络。正如您将看到的,当用户单击节点时,将看到一张包含该节点连接的表格。为此,我使用了
visEvents(select = "function(nodes) {
Shiny.onInputChange('current_node_id', nodes.nodes);
;}")
但是我不能使它在边缘选择方面同样起作用,以便使第二个数据表使用类似以下内容来显示与所选边缘相关的所有连接:
visEvents(select = "function(edges) {
Shiny.onInputChange('current_edge_id', edges.edges);
;}")
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)