CODEWITHSUNDEEP
rshiny
Beasterfield
Beasterfield

Reputation: 7123

Reactivity of dynamic number of ui elements

I have a shiny web interface, which loads an arbitrary number of datatables from a database and displays them. The approach is very similar to the one proposed here: Add a dynamic UI element in R shiny data table.

However, the number of datatables can change while working with the interface and in this case the displayed datatables need to be reloaded. My approach fails with the error message

Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

I tried to build a minimal example, which makes the error reproducible:

model.R

db <- list()
getTables <- function( n ){
  db <<- lapply(seq_len( n ), data.frame, a = 1:2, b = LETTERS[1:2])
  return(db)
}
getTableIndex <- function(){
  seq_along(db)
}

server.R

library(shiny)
shinyServer(function(input, output) {
  db_tables  <- getTables( 3 )
  db_tab_ix  <- getTableIndex()

  output$tabs <- renderUI({
    tables <- lapply( db_tab_ix, function(x){
      tableOutput(paste( "tab", x, sep="_"))
    })
    tagList(tables)
  })

  for( x in db_tab_ix ){
    local({
      output[[paste( "tab", x, sep="_")]] <- renderTable( db_tables[[x]] )
    })
  }
})

ui.R

shinyUI(fluidPage(
  mainPanel(
    uiOutput( "tabs" ),
    sliderInput( "tabs_no", "Integer:",  min=1, max=3, value=1)
  )
))

In this example everything works fine. The problem arises when replacing line 3 of the server.R with

 db_tables <- getTables( input$tabs_no )

i.e. when I try to make the data reactive.

Upvotes: 2

Views: 304

Answers (1)

Jimbo
Jimbo

Reputation: 938

Here's code that works, I don't think you really want any of that global assigning stuff:

test <- function(){
  db <- list()
  getTables <- function( n ){
    db <- lapply(seq_len( n ), data.frame, a = 1:2, b = LETTERS[1:2])
    return(db)
  }
  shinyApp(
    ui=fluidPage(
      mainPanel(
        uiOutput("tabs" ),
        sliderInput( "tabs_no", "Integer:",  min=1, max=3, value=1)
      )
    ),
    server=function(input, output) {
      db_tables <- reactive({
        return(getTables(input$tabs_no))
      })
      output$tabs <- renderUI({
        tbl<-db_tables()
        tables <- sapply(1:input$tabs_no, function(x){
          renderTable(tbl[[x]])
        })
        tagList(tables)
      })
    }
  )
}

Upvotes: 2

Related Questions