Shiny Visnetwork Взаимодействия и события - PullRequest
Новая
       27

Shiny Visnetwork Взаимодействия и события

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

Я пытаюсь создать эффект интерактивной легенды для сетевой визуализации.В идеале, я бы хотел, чтобы пользователь мог щелкнуть узел легенды, и он выделил бы / сфокусировал на большой сетевой диаграмме.

У меня есть похожая сетевая диаграмма. Мне удалось использовать выпадающий список selectInput, чтобы выполнить действие выделения / фокусировки с использованием чего-то вроде приведенного ниже фрагмента, но я не знаю, как передать значения издругая сеть против selectInput. 

 observe({
    visNetworkProxy("vis_1") %>%
      visFocus(id = input$Focus, scale = 1)%>%
      visSelectNodes(id = input$Focus)
    #  visSetSelection(id = input$Focus, highlightEdges = TRUE)
  })

Моя идея состоит в том, чтобы создать две сетевые диаграммы (одну маленькую для обозначения легенды) и большую общую сеть.Затем я могу щелкнуть легенду и сосредоточиться на группе на большем графике.Ниже приведены примеры данных для создания первой части (схема легенды и диаграмма сети) ... Я не уверен, как передать событие click и соответствующую группу.

library(shiny)
library(visNetwork)
library(DT)

server <- function(input, output, session) {
  ## data
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      group = c("info1", "info1", "info2"),
                      color = c("blue","blue","red"))
  edges <- data.frame(from = c(1,2), to = c(2,2), id = 1:2)

  ## data for legend network  
  nodesb <- data.frame(id = c("info1","info2"),
                       color = c("blue","red"))


  ##  network
  output$network_proxy1 <- renderVisNetwork({
    visNetwork(nodes, edges, main = "Network Chart") %>%
    visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
    })
  ## legend network
  output$network_proxy2 <- renderVisNetwork({
    visNetwork(nodesb, main = "Legend") %>%
    visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id', nodes.nodes);
                ;}")
    })



}

ui <- fluidPage(
  visNetworkOutput("network_proxy2", height = "100px"),
  visNetworkOutput("network_proxy1", height = "400px")
)

shinyApp(ui = ui, server = server)

1 Ответ

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

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

library(shiny)
library(visNetwork)
library(DT)
library(dplyr)

server <- function(input, output, session) {
  ## data
  nodes <- data.frame(id = 1:3, 
                      name = c("first", "second", "third"), 
                      group = c("info1", "info1", "info2"),
                      color = c("blue","blue","red"))
  edges <- data.frame(from = c(1,2), to = c(2,2), id = 1:2)

  ## data for legend network  
  nodesb <- data.frame(id = c("info1","info2"),
                       color = c("blue","red"))


  ##  network
  output$network_proxy1 <- renderVisNetwork({
    visNetwork(nodes, edges, main = "Network Chart")
})
  ## legend network
  output$network_proxy2 <- renderVisNetwork({
    visNetwork(nodesb, main = "Legend") %>%
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_id_legend', nodes.nodes);
                ;}")
})

  # Find the ID of the gorup selected and focus on the first element
  observe({

    id = nodes%>%
      filter(group %in% input$current_node_id_legend)%>%
      .$id%>%
      .[1]

    visNetworkProxy("network_proxy1") %>%
      visFocus(id = id, scale = 4)
  })

}

ui <- fluidPage(
  visNetworkOutput("network_proxy2", height = "100px"),
  visNetworkOutput("network_proxy1", height = "400px")
)

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