如何使用复选框以交互方式过滤 visNetwork 中的节点/边？ （使用R闪亮）

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

可以查看我试图实现的行为的示例here https://visjs.github.io/vis-network/examples/network/data/dynamicFiltering.html.

请在下面找到我的代码。

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)

任何帮助将不胜感激。 此致， 蒂姆

visRemoveNodes需要 id 的向量 whilevisUpdateNodes需要一个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)