我有一个简单的 Shiny 应用程序,它显示一个网络,在下表中您可以看到通过边和边的名称连接节点之间的所有连接。我想更新数据表以在单击节点时仅显示选定的节点信息。例如,当我单击节点“articaine”时,表中只会显示“articaine”连接。
#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.r
library(igraph)
library(visNetwork)
library(dplyr)
library(shiny)
library(shinythemes)
library(DT)
ui <- fluidPage(theme = shinytheme("cerulean"), # Specify that the Cerulean Shiny theme/template should be used
# Generate Title Panel at the top of the app
titlePanel("Network Visualization App"),
# Render as a sidebarLayout. Shiny expects that a sidebarPanel() function and a mainPanel() function are present.
sidebarLayout(
# Sidebar section. Can set the width of the sidebar for any value ranging from 1 to 12.
sidebarPanel(
), # End of the sidebar panel code
# Define the main panel
mainPanel(
h3("Network Visualization"),
# Plot the network diagram within the main panel.
# Note that visNetworkOutput is not a Shiny package function, but a visNetwork package function.
visNetworkOutput("plot2"),
fluidRow(
DTOutput('tbl')
)
) # End of main panel code
)
)
#server.r
library(igraph)
library(visNetwork)
library(dplyr)
library(shiny)
library(shinythemes)
server <- function (input, output, session){
# Use the renderVisNetwork() function to render the network data.
output$plot2 <- renderVisNetwork({
visNetwork(nodes = node,edge)%>%
visOptions(highlightNearest=T, nodesIdSelection = T) %>%
# Specify that hover interaction and on-screen button navigations are active
visInteraction(hover = T, navigationButtons = T) %>%
visIgraphLayout()
})
output$tbl = renderDT(
edge, options = list(lengthChange = FALSE)
)
}
最佳答案
这是一个替代解决方案,允许选择多个节点,并且不使用observe
,但在其他方面与firmo23 发布的解决方案类似。我过滤到“到”或“从”列中选定节点的任何边,因为我不清楚您要的是哪个。
另外,关于布局的一些评论:侧边栏和主面板布局不是必需的。我倾向于使用 fluidRow()
和 column()
的嵌套来显式定义面板,我在下面完成了这一点。
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,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)
由reprex package于2018年9月24日创建(v0.2.1)
关于r - 单击 Shiny 应用程序中的网络节点后更新数据表,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/52480210/