javascript - Shiny:如何在UI中直接使用Server中定义的列表

Question

我正在使用 Shiny 中的 visNetwork 包构建网络分析，想知道是否有一种方法可以直接使用 UI 中的服务器中定义的项目。

如下面的代码，对于UI中的selectInput，我想调用一个列表“nodes$id”，即Shiny 服务器中定义的数据框“节点”列。

它不起作用，因为在 UI 中调用的列表必须在 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)

提前致谢。

Answer 1

此答案仅供说明之用。但正如上面的评论中提到的，您的功能可以通过 updateSelectInput 来实现，并且可以在reactivePoll 中查询您的数据库，它搜索添加到网络中的新节点。这是一个每分钟向网络添加节点的示例。

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)