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

问题描述 投票:0回答:1

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

如下面的代码,对于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)

提前致谢。

javascript r shiny rstudio visnetwork
1个回答
2
投票

这个答案仅用于说明目的。但正如上面的评论所述,您可以使用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)
© www.soinside.com 2019 - 2024. All rights reserved.