Display issue using outputOptions

[sbihorel]

Hi,

I have a catch-22 situation to present to your attention. This is a result of an issue I posted to the Rstudio community forum (https://community.rstudio.com/t/incomplete-reactivity-with-tabpanel/2824).

I have an app with 2 tabPanels and a text box (which content depends on input fields from the 2 tabPanels). To implement full reactivity, Joe Cheng suggested to use outputOptions(output, "", suspendWhenHidden = FALSE) to force reactivity of hidden objects. This works fine, except when a rhandsontable is added in the 2nd tabPanel: If I use a outputOptions call for the rhandsontable output, the reactivity is full (ie, the text box reflect correct information) but the table does not display correctly. I I do not use an outputOptions call, the table is displayed correctly but the reactivity is partial.

Below is the code I submitted to the Rstudio community:

Any thoughts?

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)

[Ravi1008]

@sbihorel I am also facing the same issue that you've described and want to check if you've figured out a workaround. I am writing an enterprise application, so using the dev version of rhandsontable isn't an option.

[sbihorel]

@Ravi1008 Sorry. I am in the same boat. Waiting for the release of a new version.

[Ravi1008]

@trafficonese Would you mind adding a reproducible example ? say using the Code that sbihorel already provided? I've tried to include the jQuery template you've shared but couldn't get it working.

[trafficonese]

@Ravi1008 Sry i misread the question and my problem was a little different, so I deleted my comment. If you want to see a reproducible example of that jQuery-snippet you can run runGitHub(repo = "jQueryLayout", username = "trafficonese") which uses DT-tables (but its the same for handsontables) and multiple tabs. I had the problem, that the table would not appear when clicking on the "Table"-tab.

But this problem needs data from both tabs, so indeed they shouldnt be suspended when hidden.

[sbihorel]

@jrowen I have noticed that the code fix to this problem predates the release of rhandsontable 0.3.7 on CRAN (aug 2018 vs nov 2018). However, version 0.3.7 does not include it... Is there an issue with this fix?

[alexander-macandrew]

Hi @jrowen, agree with @sbihorel that this issue appears to still be a catch-22? Is there a workaround or dev version of the package available with a fix?

[stla]

Same problem here. Does anyone has a solution?

[stla]

I've found a workaround:

library(shiny)
library(rhandsontable)
library(htmlwidgets)

ui <- fluidPage(
  tabsetPanel(
    tabPanel(
      "Tab 1",
      rHandsontableOutput("hot1")
    ),
    tabPanel(
      "Tab 2",
      rHandsontableOutput("hot2")
    )
  )
)

server <- function(input, output){

  output[["hot1"]] <- renderRHandsontable({
    if(!is.null(input[["hot1"]])){
      DF <- hot_to_r(input[["hot1"]])
    }else{
      DF <- iris[1:5,]
    }
    rhandsontable(DF, rowHeaders = NULL) %>% 
      hot_table(highlightRow = TRUE, contextMenu = FALSE)
  })

  output[["hot2"]] <- renderRHandsontable({
    if(!is.null(input[["hot2"]])){
      DF <- hot_to_r(input[["hot2"]])
    }else{
      DF <- data.frame(
        index = 1:5, 
        label = LETTERS[1:5], 
        stringsAsFactors = FALSE)
    }
    rhandsontable(DF, rowHeaders = NULL) %>% 
      hot_col("index", readOnly = TRUE) %>%
      hot_col("label", type = "text") %>% 
      hot_cols(colWidths = c(50, 300)) %>% 
      hot_table(highlightRow = TRUE, contextMenu = FALSE) %>% 
      onRender("function(el, x){
                  var hot = this.hot;
                  $('a[data-value=\"Tab 2\"').on('click', function(){
                    setTimeout(function(){hot.render();}, 0);
                  });
                }")

  })
  outputOptions(output, "hot2", suspendWhenHidden = FALSE)

}

shinyApp(ui, server)

[pepijn-devries]

I've found a workaround:

library(shiny)
library(rhandsontable)
library(htmlwidgets)

ui <- fluidPage(
  tabsetPanel(
    tabPanel(
      "Tab 1",
      rHandsontableOutput("hot1")
    ),
    tabPanel(
      "Tab 2",
      rHandsontableOutput("hot2")
    )
  )
)

server <- function(input, output){

  output[["hot1"]] <- renderRHandsontable({
    if(!is.null(input[["hot1"]])){
      DF <- hot_to_r(input[["hot1"]])
    }else{
      DF <- iris[1:5,]
    }
    rhandsontable(DF, rowHeaders = NULL) %>% 
      hot_table(highlightRow = TRUE, contextMenu = FALSE)
  })

  output[["hot2"]] <- renderRHandsontable({
    if(!is.null(input[["hot2"]])){
      DF <- hot_to_r(input[["hot2"]])
    }else{
      DF <- data.frame(
        index = 1:5, 
        label = LETTERS[1:5], 
        stringsAsFactors = FALSE)
    }
    rhandsontable(DF, rowHeaders = NULL) %>% 
      hot_col("index", readOnly = TRUE) %>%
      hot_col("label", type = "text") %>% 
      hot_cols(colWidths = c(50, 300)) %>% 
      hot_table(highlightRow = TRUE, contextMenu = FALSE) %>% 
      onRender("function(el, x){
                  var hot = this.hot;
                  $('a[data-value=\"Tab 2\"').on('click', function(){
                    setTimeout(function(){hot.render();}, 0);
                  });
                }")

  })
  outputOptions(output, "hot2", suspendWhenHidden = FALSE)

}

shinyApp(ui, server)

I can confirm that this workaround fixed the issue for me. In my case, I used a shiny dashboardPage. The key in the solution provided here is in the 'onRender' bit.