r - 如何使用复选框以交互方式从 visNetwork 中过滤节点/边？ (使用 R Shiny )

Question

我使用 Shiny 和 visNetwork R 包创建了一个交互式网络可视化。我想让用户通过在 UI 中使用复选框来删除/添加节点和边。我设法让它部分工作，但不知何故，当过滤多个项目时，我的解决方案不起作用。

可以查看我试图实现的行为示例 here .

请在下面找到我的代码。

library(visNetwork)
library(shiny)
library(dplyr)

nodes <- data.frame("id" = 1:6)
edges <- data.frame("id" = 1:4, "to" = c(1,2,4,5), "from" = c(2,3,5,6))

ui <- fluidPage(title = "example",
                fillPage(
                  sidebarLayout(
                    sidebarPanel(
                      checkboxGroupInput(inputId = "filterNodes", 
                                         label = "Select nodes:", 
                                         choices = nodes$id, 
                                         selected = nodes$id),
    
                      width = 3),
                    mainPanel(
                      visNetworkOutput("network_proxy_update",width = "100%", height = "90vh"),
                      width = 9)
                  )
                  
                )
)

server <- function(input, output) {

  
  output$network_proxy_update <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes (color = "blue")
  })
  
  observe ({
  
    filteredNodes <- data.frame("id" = nodes[nodes$id %in% input$filterNodes, "id"])
    hiddenNodes <- anti_join(nodes, filteredNodes)
    
    
    visNetworkProxy("network_proxy_update") %>%
      visRemoveNodes(id = hiddenNodes) %>%
      visUpdateNodes(nodes = filteredNodes)
      
  })
}

shinyApp(ui = ui, server = server)

如有任何帮助，我们将不胜感激。最好的祝福，蒂姆

Answer 1

visRemoveNodes 需要一个 id 向量，而 visUpdateNodes 需要一个 data.frame 节点:

library(visNetwork)
library(shiny)
library(dplyr)

nodes <- data.frame("id" = 1:6)
edges <- data.frame(
  "id" = 1:4,
  "to" = c(1, 2, 4, 5),
  "from" = c(2, 3, 5, 6)
)

ui <- fluidPage(title = "example",
                fillPage(sidebarLayout(
                  sidebarPanel(
                    checkboxGroupInput(
                      inputId = "filterNodes",
                      label = "Select nodes:",
                      choices = nodes$id,
                      selected = nodes$id
                    ),
                    width = 3
                  ),
                  mainPanel(
                    visNetworkOutput("network_proxy_update", width = "100%", height = "90vh"),
                    width = 9
                  )
                )))

server <- function(input, output) {
  output$network_proxy_update <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes (color = "blue")
  })
  
  myVisNetworkProxy <- visNetworkProxy("network_proxy_update")
  
  observe ({
    filteredNodes <- nodes[nodes$id %in% input$filterNodes, , drop = FALSE]
    hiddenNodes <- anti_join(nodes, filteredNodes)
    visRemoveNodes(myVisNetworkProxy, id = hiddenNodes$id)
    visUpdateNodes(myVisNetworkProxy, nodes = filteredNodes)
  })
}

shinyApp(ui = ui, server = server)