Как показать блестящий ввод узлов и ребер из visNetwork вместе вместо отдельных - PullRequest
Новая
       39

Как показать блестящий ввод узлов и ребер из visNetwork вместе вместо отдельных

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

Я строю сеть в Shiny с использованием пакета visNetwork.

Интересна функция показа ввода узлов и ребер.Однако ввод узлов и ребер можно показывать только отдельно, а не вместе, в одном окне.

Я следовал следующей инструкции https://datastorm -open.github.io / visNetwork / spark.html создать интерактивный ввод узлов и ребер, наведя курсор на узлы и ребра.Это делается с помощью hoverNode / hoverEdge arg в функции visEvent в пакете visNetwork.Это основано на функции Shiny.OnInputChange в событии javascript 

library(visNetwork)
library(shiny)

server <- function(input, output) {
  output$network <- renderVisNetwork({
    # minimal example
    nodes <- data.frame(id = 1:3, label = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))

    visNetwork(nodes, edges) %>%
      visInteraction(hover = TRUE) %>%
      visEvents(hoverNode = "function(nodes) {
        Shiny.onInputChange('current_node_id', nodes);
      ;}"), hoverEdge = "function(edges) {
        Shiny.onInputChange('current_edge_id', edges);
      ;}")
  })

  output$shiny_return <- renderPrint({
    input$current_node_id
  })
}

  output$shiny_return <- renderPrint({
    input$current_edge_id
  })
}

ui <- fluidPage(
  visNetworkOutput("network"),
  verbatimTextOutput("shiny_return")
)

shinyApp(ui = ui, server = server)

На основе кода у меня есть 2 вывода renderPrint.Я хочу сохранить для 1, однако, это ограничено аргументами hoverNode / hoverEdge.

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

1 Ответ

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

Shiny.onInputChange позволяет нам указать любое имя для вывода.Поскольку в любой момент времени вы можете навести курсор мыши на узел или ребро, вы можете просто дать узлам и ребрам одно и то же имя в коде JS и сослаться на этот ввод в коде Shiny на стороне сервера.Вот как это будет выглядеть: 

library(visNetwork)
library(shiny)

server <- function(input, output) {
  output$network <- renderVisNetwork({
    # minimal example
    nodes <- data.frame(id = 1:3, label = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))

    visNetwork(nodes, edges) %>%
      visInteraction(hover = TRUE) %>%
      visEvents(hoverNode = "function(nodes) {
                Shiny.onInputChange('unique_id', nodes);
                ;}", hoverEdge = "function(edges) {
    Shiny.onInputChange('unique_id', edges);
    ;}")
  })

  output$shiny_return <- renderPrint({
    input$unique_id
  })
}

ui <- fluidPage(
  visNetworkOutput("network"),
  verbatimTextOutput("shiny_return")
)

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