Как вручную ввести идентификатор узла, чтобы выбрать / выделить узлы в visNetwork

Question

Я строю сеть, используя пакет visNetwork в приложении Shiny.

В пакете visNetwork есть аргумент nodeIdSelection в функции visOption для выбора / выделения узлов.

Однако мы можем выбрать только узлы из выпадающего меню вместо того, чтобы вручную вводить идентификатор узла для выбора в этой функции. Трудно найти идентификатор узла, если в выпадающем меню много идентификаторов узлов.

Мне интересно, есть ли способ достичь этой функции. Если это невозможно в visNetwork, я думаю реализовать в Shiny возможные функции для ее решения.

Ниже мой текущий код visNetwork.

# data used in next examples
nb <- 10
nodes <- data.frame(id = 1:nb, label = paste("Label", 1:nb),
                    group = sample(LETTERS[1:3], nb, replace = TRUE), value = 1:nb,
                    title = paste0("<p>", 1:nb,"<br>Tooltip !</p>"), stringsAsFactors = FALSE)

edges <- data.frame(from = c(8,2,7,6,1,8,9,4,6,2),
                    to = c(3,7,2,7,9,1,5,3,2,9),
                    value = rnorm(nb, 10), label = paste("Edge", 1:nb),
                    title = paste0("<p>", 1:nb,"<br>Edge Tooltip !</p>"))

visNetwork(nodes, edges, height = "500px", width = "100%") %>% 
  visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE) %>%
  visLayout(randomSeed = 123)

Заранее спасибо.

Answer 1

Вы можете использовать Shiny с visSelectNodesи установить highlightNearestв вариантах для достижения того же результата. При этом вы можете настроить ввод в каталоге блестящих виджетов по своему усмотрению.

      library(shiny)
library(visNetwork)

server <- function(input, output) {
output$network_proxy_nodes <- renderVisNetwork({
    # minimal example
    nodes <- data.frame(id = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))
    
    visNetwork(nodes, edges) %>% 
        visOptions(highlightNearest = TRUE)
})


observe({
        visNetworkProxy("network_proxy_nodes") %>%
            visSelectNodes(id = input$Focus, highlightEdges = T)
    })

}

ui <- fluidPage(
    fluidRow(
        column(
            width = 4,

            selectInput("Focus", "Focus on node :",
                    c(1:3))
        ),
        column(
            width = 8,
            visNetworkOutput("network_proxy_nodes", height = "400px")
        )
    )
)

shinyApp(ui = ui, server = server)