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

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

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

Я строю сетевой анализ с использованием пакета visNetwork в Shiny и задаюсь вопросом, есть ли способ напрямую использовать элементы, определенные в Server в пользовательском интерфейсе.

Как показано ниже, для selectInput в UI я бы хотел назвать список "node $ id" , который представляет собой столбец "узлов" dataframe , определенный в Shinyсервер .

Он не работал, так как списки, вызываемые в пользовательском интерфейсе , должны быть предварительно определены в R вместо Shiny Server . 

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

    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


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

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

shinyApp(ui = ui, server = server)

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

1 Ответ

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

Этот ответ носит иллюстративный характер.Но, как упоминалось в комментариях выше, ваша функциональность может быть достигнута с помощью updateSelectInput, а ваша база данных может быть запрошена в реактиве, который ищет новые узлы, добавленные в сеть.Вот пример, где узлы добавляются каждую минуту в сеть. 

library(shiny)
library(visNetwork)
library(lubridate)

#Values to initialize
nodes <- data.frame(id = 2:4)
edges <- data.frame(from = c(2,3), to = c(2,4))

server <- function(input, output,session) {

  data = reactivePoll(1000,session,
                      checkFunc = function(){
                        # SELECT MAX(timestamp) FROM table

                        #For illustration it triggeres every minute
                        minute(Sys.time())
                      },
                      valueFunc = function(){
                        #SELECT * FROM table

                        nodes <<- rbind(nodes,data.frame(id = minute(Sys.time())))
                        edges <<- rbind(edges,data.frame(from = c(minute(Sys.time())),to = 2))
                        return(list(nodes = nodes,edges = edges))
                      }
  )

  #Use the dataframe of nodes you got above to set the updateSelectInput
  observe({
    req(data())
    updateSelectInput(session,"Focus",choices = data()$nodes$id)
  })


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


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

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

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