Incomplete reactivity with tabPanel

shiny
1

Hi,

I have put together a reproducible example that illustrates the problem that I have with a much bigger Shiny app. So, the basic idea of the app is the following:

  • the app has 2 tabs and a text box,
  • content of tab #2 depends on selection made in tab #1, and
  • the content of the text box depends on the selection made in the 2 tabs.

Problems:

  1. when the app opens, the content of the text box ignores the default content of tab #2
  2. the content of the text box only reflects the changes made in the currently active tab and seem to ignore the other tab...

It looks like the cascading reactivity is not happening and I would very much appreciate any suggestion to force the full reactive cascade.

Thanks

PS: I know that some coding options (including the make.txt function and the intermediary reactive objects) may be superfluous for such a little useless app, but they reflect what it happening in my more complex app. So please, ignore this, except if that is the source of my reactivity problem.
PPS: this post is a duplicate of a post to the shiny-discuss Google group

require(shiny)
require(shinydashboard)

make.txt <- function(input, table){
  c(
    sprintf('Choice: %s', input$choiceInput),
    sprintf('Sub-choice: %s', input$subchoiceInput)
  )
}

myServer <- function(input, output, session) {
 
  #subchoiceUI
  output$subchoiceUI <- renderUI({
   
    if (input$choiceInput == 'A'){
      subchoices <- paste0('a', 1:5)
    } else {
      subchoices <- paste0('b', 11:15)
    }
   
    selectInput(
      inputId = 'subchoiceInput',
      label = 'Sub choice',
      choices = subchoices,
      selected = subchoices[1],
      width = '100%'
    )
   
  })
 
  # text UI
  mytext <- reactive({
    return(make.txt(input, table))
  })
 
  output$textUI <- renderText({
    paste(mytext(), collapse = '\n')
  })
 
}

myUI <- function(){
  dashboardPage(
    header = dashboardHeader(
      title = 'Reactivity problem'
    ),
    sidebar = dashboardSidebar(
      disable = TRUE
    ),
    body = dashboardBody(
      fluidRow(
        column(
          width = 6,
          tabBox(
            tabPanel(
              title = 'Settings',
              fluidRow(
                column(
                  width = 12,
                  selectInput(
                    inputId = 'choiceInput',
                    label = 'Choice',
                    choices = c('A','B'),
                    selected = 'A',
                    width = '100%'
                  )
                )
              )
            ),
            tabPanel(
              title = 'Sub-settings',
              fluidRow(
                column(
                  width = 12,
                  uiOutput('subchoiceUI')
                )
              )
            ),
            width = 12
          )
        ),
        column(
          width = 6,
          box(
            width = 12,
            title = 'Text box',
            verbatimTextOutput('textUI')
          )
        )
      )
    )
  )
}

shinyApp(ui = myUI, server = myServer)
2

You need to add the following line to your server function:

outputOptions(output, "subchoiceUI", suspendWhenHidden = FALSE)

I recommend putting it either immediately above or below the declaration for output$subchoiceUI.

The reason for this is that Shiny assumes that outputs that are not displayed, don't need to be calculated or sent to the client. This is the case for things like plots and tables that have a purely visual effect. But in your case, the UI that you're rendering has the side effect of introducing an input, which matters even when the user isn't looking at it. So the outputOptions call is how you tell Shiny not to suspend the output even if it's hidden.

2 Likes
3

This works perfectly in the same scale example. The original app will require more outputOptions calls, so I will test this later.

Thank you!

1 Like
4

Hi,

After testing adding outputOptions calls in my bigger application, I have a follow-up question with respect to the use of outputOptions call with rhandsontable output. In the updated code below, although the reactivity seems correct based upon the content of the text box, the display of the table itself is weird. Removing the outputOptions call relative to the table object solves the display problem but breaks the full reactivity.

Any idea?


require(shiny)
require(shinydashboard)
require(rhandsontable)

make.txt <- function(input, table){
  
  c(
    sprintf('Choice: %s', input$choiceInput),
    sprintf('Sub-choice: %s', input$subchoiceInput),
    sprintf('Table content: %s', paste(table[,1], collapse = ', '))
  )
}

myServer <- function(input, output, session) {
  
  output$table <- renderRHandsontable({
    
    if (input$choiceInput=='A'){
      DF <- data.frame(animal = c('alligator', 'albatros'),
                       color = c('green', 'white'))
    } else {
      DF <- data.frame(animal = c('bear', 'bee'),
                       color = c('black', 'yellow'))
    }
    
    rhandsontable(
      data = DF,
      rowHeaders = NULL,
      contextMenu = FALSE,
      width = 600,
      height = 300
    )
    
  })
  
  outputOptions(output, 'table', suspendWhenHidden = FALSE)
  
  #subchoiceUI
  output$subchoiceUI <- renderUI({
    
    if (input$choiceInput == 'A'){
      subchoices <- paste0('a', 1:5) 
    } else {
      subchoices <- paste0('b', 11:15) 
    } 
    
    fluidRow(
      column(
        width =12,
        selectInput(
          inputId = 'subchoiceInput',
          label = 'Sub choice',
          choices = subchoices,
          selected = subchoices[1],
          width = '100%'
        ),
        hr(),
        rHandsontableOutput('table')
      )
    )
    
  })
  
  outputOptions(output, 'subchoiceUI', suspendWhenHidden = FALSE)
  
  # text UI
  mytext <- reactive({
    return(make.txt(input, hot_to_r(input$table)))
  })
  
  output$textUI <- renderText({
    paste(mytext(), collapse = '\n')
  })
  
}

myUI <- function(){
  fluidPage(
    fluidRow(
      column(
        width = 6,
        tabBox(
          tabPanel(
            title = 'Settings',
            fluidRow(
              column(
                width = 12,
                selectInput(
                  inputId = 'choiceInput',
                  label = 'Choice',
                  choices = c('A','B'),
                  selected = 'A',
                  width = '100%'
                )
              )
            )
          ),
          tabPanel(
            title = 'Sub-settings',
            fluidRow(
              column(
                width = 12,
                uiOutput('subchoiceUI')
              )
            )
          ),
          width = 12
        )
      ),
      column(
        width = 6,
        box(
          width = 12,
          title = 'Text box',
          verbatimTextOutput('textUI')
        )
      )
    )
  )
}

shinyApp(ui = myUI, server = myServer)