Панель поиска с графом visNetwork в блестящем

#r #graph #shiny #shinydashboard

#r #График #блестящий #shinydashboard

Вопрос:

Я построил сетевой график с помощью visNetwork и Shiny. Я очень доволен результатами. Что я хотел бы сделать, так это использовать панель поиска (например: http://projects .flowingdata.com/tut/interactive_network_demo /) для поиска узлов в моих данных.

Я использую shinydashboard. Поэтому я попытался использовать «sidebarSearchForm». Однако, когда я запускаю приложение и пытаюсь использовать форму поиска, ничего не возвращается.

Вот мой код для пользовательского интерфейса:

 ui <- dashboardPage(skin = "black",
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Network", tabName = "network", icon = icon("dashboard")),
      sidebarSearchForm(textId = "searchText", buttonId = "searchButton", label = "Search...")
   )
  ),
  dashboardBody(
    box(
      title = "Network",  status = "warning", solidHeader = TRUE, collapsible = TRUE,
      visNetworkOutput("network_proxy", height = 700)  
    )
  )
)#end ui

Вот код для сервера;

 server <- function(input, output) {
  output$network_proxy <- renderVisNetwork({
    visNetwork(my.nodes, my.edges, height = "100%")
  })
  output$searchString <- renderText({
    if (input$searchButton == 0)
      return()
    isolate({input$searchString})
  })
} #end server

Ответ №1:

Вы можете сделать это с помощью visNetworkProxy и visSelectNodes , например, вот так, с помощью простого grepl :

 nodes <- data.frame(id = 1:3, label = c("A", "B", "A"))
edges <- data.frame(from = c(1,2), to = c(1,3))

require(visNetwork)
require(shiny)
require(shinydashboard)
ui <- dashboardPage(skin = "black",
                    dashboardHeader(),
                    dashboardSidebar(
                      sidebarMenu(
                        menuItem("Network", tabName = "network", icon = icon("dashboard")),
                        sidebarSearchForm(textId = "searchText", buttonId = "searchButton", label = "Search...")
                      )
                    ),
                    dashboardBody(
                      box(
                        title = "Network",  status = "warning", solidHeader = TRUE, collapsible = TRUE,
                        visNetworkOutput("network_proxy", height = 700)
                      )
                    )
)


server <- function(input, output, session) {
  output$network_proxy <- renderVisNetwork({
    visNetwork(nodes, edges, height = "100%")
  })

  observe({
    if(input$searchButton > 0){
      isolate({
        print(input$searchText)
        current_node <- nodes[grep(input$searchText, nodes$label), "id"]
        print(current_node)
        visNetworkProxy("network_proxy") %>% visSelectNodes(id  = current_node)
      })
    }
  })

} #end server

shiny::shinyApp(ui, server)

1. Спасибо. Я пробовал это, но строка поиска по-прежнему ничего не возвращает.

2. Если вы используете searchButton, вам нужно нажать на значок, чтобы включить изменение

3. Спасибо. Когда я нажимаю на нее, она выбирает все узлы в сети.

4. Глупая ошибка с моей стороны. Мне нужно было использовать правильный фрейм данных с моими сетевыми данными. Также я сделал его нечувствительным к регистру и точным совпадением с:Кроме того, я использовал оператор which, чтобы получить точное совпадение: current_node <- network $ x $nodes[which(network $ x $ nodes $ id == input $ searchText), «label»]. Еще раз спасибо!

5. Я попытался отредактировать свой комментарий, но не смог этого сделать… Ваше решение сработало… Я смог получить точное совпадение без учета регистра с помощью: find_me <- paste0("^",input$searchText,"$") и затем current_node <- network$x$nodes[grep(find_me, network$x$nodes$id, ignore.case = T), "label"] . Еще раз спасибо.

Ответ №2:

Вы проверили это:

http://datastorm-open.github.io/visNetwork/shiny.html

Проверьте visNetworkProxy раздел.

Кроме того, демонстрационный код, прилагаемый к пакету, содержит то, чего вы хотите достичь.

Ответ №3:

Приведенный выше код из bthieurmel можно изменить на приведенный ниже, чтобы включить поиск без учета регистра:

 current_node <- nodes[grep(input$searchText, nodes$label, ignore.case = T), "id"]