Shiny: How to directly use lists defined in Server in UI

Question

I am building a network analysis using visNetwork package in Shiny and wondering if there is a way to directly use items defined in Server in UI.

As the code below, for selectInput in UI, I'd like to call a list "nodes$id", which is a column of dataframe "nodes" defined in Shiny server.

It did not work as lists called in UI have to be pre-defined in R instead of 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)

Thanks in advance.

Answer 1

This answer is for illustrative purposes. But as mentioned in the comments above, your functionality can be achieved with a updateSelectInput and your database can be queried in a reactivePoll which searches for new nodes added to the network. Here is an example where nodes are added every minute to the network.

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)