Question

我使用了此question中给出的示例，但我想调整它以显示已选择的节点的数据（不是所有节点而只是此节点）并且也不使用操作按钮这样一旦我点击节点，数据就会显示出来。

我尝试了许多解决方案但没有成功。

当我创建图表时，我上传了一个CSV文件并将其他参数关联到节点（大小，标题......）。当我选择一个节点时，是否也可以显示这些参数：

节点$ COMPANY_NAME

节点$ company_postcode

节点$ amount.size

...

这是我以前开始使用的代码，由@xclotet提供

require(shiny)
require(visNetwork)

server <- function(input, output, session) {
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      extra = c("info1", "info2", "info3"))
  edges <- data.frame(from = c(1,2), to = c(1,3), id= 1:2)

  output$network_proxy <- renderVisNetwork({
    visNetwork(nodes, edges)
  })


  output$nodes_data_from_shiny <- renderDataTable({
    if(!is.null(input$network_proxy_nodes)){
      info <- data.frame(matrix(unlist(input$network_proxy_nodes), ncol =     dim(nodes)[1],
                        byrow=T),stringsAsFactors=FALSE)
      colnames(info) <- colnames(nodes)
      info
    }
  })

  observeEvent(input$getNodes,{
    visNetworkProxy("network_proxy") %>%
      visGetNodes() 
  })
}

ui <- fluidPage(
  visNetworkOutput("network_proxy", height = "400px"),
  dataTableOutput("nodes_data_from_shiny"),
  actionButton("getNodes", "Nodes")
)

shinyApp(ui = ui, server = server)

Answer 1

提出另一个建议，因为上面的建议看起来并不优雅：

library(shiny)
library(visNetwork)
library(DT)

server <- function(input, output, session) {
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      extra = c("info1", "info2", "info3"))
  edges <- data.frame(from = c(1,2), to = c(1,3), id = 1:2)

  output$network_proxy <- renderVisNetwork({
    visNetwork(nodes, edges) %>%
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
})


  myNode <- reactiveValues(selected = '')

  observeEvent(input$current_node_id, {
    myNode$selected <<- input$current_node_id
  })

output$table <- renderDataTable({
    nodes[which(myNode$selected == nodes$id),]
})

output$dt_UI <- renderUI({
  if(nrow(nodes[which(myNode$selected == nodes$id),])!=0){
    dataTableOutput('table')
  } else{}

})


}

ui <- fluidPage(
  visNetworkOutput("network_proxy", height = "400px"),
  dataTableOutput("nodes_data_from_shiny"),
  uiOutput('dt_UI')
)

shinyApp(ui = ui, server = server)

Answer 2

要显示所选节点的数据，您可以调整visNetwork Shiny webpage中给出的示例。在该示例中，hoverNode visEvents选项用于获取 hovered 节点的信息。

要获取所选节点ID ，可以使用：

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

此函数将节点（nodes.nodes）的ID设置为input$current_node_id。然后，您可以使用此信息仅显示与该节点对应的信息（通过对data.frame进行子集化）。

下面，提供的示例适合回答问题：

require(shiny)
require(visNetwork)

server <- function(input, output, session) {
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      extra = c("info1", "info2", "info3"))
  edges <- data.frame(from = c(1,2), to = c(1,3), id = 1:2)

  output$network_proxy <- renderVisNetwork({
    visNetwork(nodes, edges) %>%
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
  })

  output$nodes_data_from_shiny <- renderDataTable( {
    if (!is.null(input$current_node_id) && !is.null(input$network_proxy_nodes)) {
      info <- data.frame(matrix(unlist(input$network_proxy_nodes), 
                                ncol = dim(nodes)[1], byrow = T),
                         stringsAsFactors = FALSE)
      colnames(info) <- colnames(nodes)
      info[info$id == input$current_node_id, ]
    }
  })

  observeEvent(input$current_node_id, {
    visNetworkProxy("network_proxy") %>%
      visGetNodes() 
  })

}

ui <- fluidPage(
  visNetworkOutput("network_proxy", height = "400px"),
  dataTableOutput("nodes_data_from_shiny"),
  actionButton("getNodes", "Nodes")
)

shinyApp(ui = ui, server = server)

Answer 3

提供另一个我觉得更简单的版本

require(shiny)
require(visNetwork)

server <- function(input, output, session) {
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      extra = c("info1", "info2", "info3pp"))
  edges <- data.frame(from = c(1,2), to = c(1,3), id = 1:2)
  output$network_proxy <- renderVisNetwork({
    visNetwork(nodes, edges) %>%
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
  })

  output$nodes_data_from_shiny <- renderDataTable( {
      info <- data.frame(nodes)

      info[info$id == input$current_node_id, ]

  })

  observeEvent(input$current_node_id, {
    visNetworkProxy("network_proxy") %>%
      visGetNodes() 
  })

}

ui <- fluidPage(
  visNetworkOutput("network_proxy", height = "400px"),
  dataTableOutput("nodes_data_from_shiny")
)

shinyApp(ui = ui, server = server)

从没有actionButton的visNetwork图中获取选定的节点数据

3 个答案: