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

Question

我使用了这个中给出的示例，但我想对其进行调整以显示已经 selected 的节点的数据（不是所有节点，而是只有这个节点）也不要使用操作按钮，以便在我单击节点时立即显示数据。

我尝试了很多解决方案都没有成功。

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

节点$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

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

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

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

这个函数将节点的id(nodes.nodes)设置为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 2

提出另一个建议，因为上面的建议似乎没有那么优雅：

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 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 图中获取选定的节点数据

Get selected Node data from visNetwork graph without actionButton

r

graph

shiny

vis.js