Как использовать visNetworkProxy в Shiny для взаимодействия с узлами на основе идентификаторов узлов - PullRequest
Новая
       52

Как использовать visNetworkProxy в Shiny для взаимодействия с узлами на основе идентификаторов узлов

0 голосов
/ 26 февраля 2019

Я строю сетевой анализ в приложении Shiny.

Я хочу использовать функцию visNetworkProxy , чтобы взаимодействовать (фокусировать / выбирать) узлы на основе node ids .

Однако "node $ id" в selectInput в пользовательском интерфейсе должно быть предопределено .В этом случае я должен определить узлы и ребра вне сервера , а не внутри сервера.

Из-за особенностей моего проекта, я должен сохранить узлы и ребра, определенные всервер для их обновления с базой данных.

Ниже мой код: 

  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) %>% visNodes(color = "blue")
  })


  observe({
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observe({
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green")),
      selectInput("Focus", "Focus on node :",
                  nodes$id)
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px")
    )
  )
)

shinyApp(ui = ui, server = server)

Мне интересно, есть ли способ взаимодействовать с узлами с узлами$ id , а хранить узлы и ребра внутри сервера .

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

1 Ответ

0 голосов
/ 26 февраля 2019

Вот кое-что, что будет работать.Вам необходимо динамически визуализировать selectInput на основе узлов. 

library(shiny)

 server <- function(input, output) {

  # minimal example
  nodes <- data.frame(id = 1:3)
  edges <- data.frame(from = c(1,2), to = c(1,3))

  output$network_proxy_nodes <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observeEvent(input$Focus, {
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observeEvent(input$color, {
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

  output$choose_node <- renderUI({
    selectInput("Focus", "Focus on node :",
                nodes$id)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green"))
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px"),
      uiOutput("choose_node")
    )
  )
)

shinyApp(ui = ui, server = server)

РЕДАКТИРОВАТЬ

После вашего комментария добавьте кнопку. 

library(shiny)

 server <- function(input, output) {

  # minimal example
  nodes <- data.frame(id = 1:3)
  edges <- data.frame(from = c(1,2), to = c(1,3))

  output$network_proxy_nodes <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observeEvent(input$focus_now, {
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observeEvent(input$color, {
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

  output$choose_node <- renderUI({
    selectInput("Focus", "Focus on node :",
                nodes$id)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green"))
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px"),
      uiOutput("choose_node"),
      actionButton("focus_now", "FOCUS")
    )
  )
)

shinyApp(ui = ui, server = server)
...