r - 在 VisNetwork 中选择节点时如何显示节点的标签？

Question

我想在选择节点时显示节点标签，并且仅在选择它们时显示。这是我一直在尝试的，但问题是一旦我选择了一个或多个节点，标签确实会出现，但是当我取消选择它们以选择其他节点时它会卡住并且不会再消失。

library(shiny)
library(visNetwork)

ui <- fluidPage(
  visNetworkOutput("network"),
  selectInput("selectedNodes", "", choices = c("",1:3), multiple = TRUE)
)
server <- function(input, output, session) {

  output$network <- renderVisNetwork({
    nodes <- data.frame(id = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))
    visNetwork(nodes, edges) %>% visInteraction(multiselect = T)
  })

  observe({
    req(input$selectedNodes)
    selected_ids = input$selectedNodes
    visNetworkProxy("network") %>% 
      visUpdateNodes(nodes = data.frame(id=selected_ids,label=paste("Label",selected_ids)))
  })

  observe({
    print(input$network_selectedNodes)
  })

}

shinyApp(ui = ui, server = server)

感谢您的帮助 ！

Answer 1

我敢肯定，这不是最佳解决方案。然而，它奏效了。:)

library(shiny)
library(visNetwork)

# we need to store what was the previous selection to compare it with the new one. 
# so we can track the changes and update the network
previous_selection = NA

ui <- fluidPage(
  visNetworkOutput("network"),
  selectInput("selectedNodes", "", choices = c("",1:3), multiple = TRUE)
)

server <- function(input, output, session) {

  output$network <- renderVisNetwork({
    # instead of missing the label column, set it as empty character variable
    nodes <- data.frame(id = 1:3, label = "")
    edges <- data.frame(from = c(1,2), to = c(1,3))
    visNetwork(nodes, edges) %>% 
      visInteraction(multiselect = T)
  })

  observe({ 
  # changed req() to if statement, as we also need to update the network 
  # even in case if user removed the selection at all
  if(length(input$selectedNodes) > 0){
    selected_ids = input$selectedNodes

    # here we compare previous selection with the existing one
    if(!identical(selected_ids, previous_selection)){

      # recreate dataframe with nodes
      nodes <- data.frame(id = 1:3, label = "")

      # for those ids, which appears in selection update the label column
      nodes$label = ifelse(nodes$id %in% selected_ids, paste("Label", nodes$id), "")

      visNetworkProxy("network") %>% 
        visUpdateNodes(nodes = nodes) %>% 

      # save the current selection     
      previous_selection = selected_ids
    }
  } else {

    # that is what we do in case if nothing is selected
    nodes <- data.frame(id = 1:3, label = "")
    visNetworkProxy("network") %>% 
      visUpdateNodes(nodes = nodes)

    previous_selection = NA
  }
  })

}

shinyApp(ui = ui, server = server)