When running the code posted at the bottom, the object "hottable" rendered in the "Slave table" tab does not correctly render when outputOptions() is activated at the bottom of the server() section of the code, as illustrated in the image below. Comment out outputOptions() and "hottable" correctly renders. But the use of outputOptions() is critical in this code in order to make "hottable" completely dependent on the column addition/deletion actions in the "Master table" tab (other reactivity problems arise when not using outputOptions()). For reasons not shown in this minimalist example, the action buttons have to be a in a separate tab panel from "hottable". How can this be fixed so "hottable" correctly renders without having to click on it?

Illustration:

Code:

library(dplyr)
library(rhandsontable)
library(shiny)

myDF <- data.frame('Series 1' = c(20,15), check.names = FALSE)
rownames(myDF) <- c('Boy','Girl') 

ui <- pageWithSidebar(
  headerPanel(""),sidebarPanel(""),
  mainPanel(
    tabsetPanel(
      tabPanel("Master table", hr(),
        actionButton("addSeries", "Add", width = 80),
        fluidRow(
          column(2,actionButton("delSeries","Delete", width = 80)),
          column(3,uiOutput("delSeries1")) 
        ),
      ),
      tabPanel("Slave table", hr(),rHandsontableOutput('hottable'))
    )
  )
)

server <- function(input, output) {
  emptyTbl <- reactiveVal(myDF)
  
  observeEvent(input$hottable, {emptyTbl(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({
    rhandsontable(emptyTbl(),rowHeaderWidth = 100, useTypes = TRUE)%>%
      hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) %>%
      hot_cols(colWidths = 80)
  })
  
  observeEvent(input$addSeries, {
    newCol <- data.frame(c(20,15))
    names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable))   1)
    emptyTbl(cbind(emptyTbl(),newCol))
  })
  
  observeEvent(input$delSeries2, {
    tmp <- emptyTbl()                                       
    if(ncol(tmp) > 1){
      delCol <- input$delSeries2                              
      tmp <- tmp[ , !(names(tmp) %in% delCol), drop = FALSE]  
      newNames <- sprintf("Series %d",seq(1:ncol(tmp)))       
      names(tmp) <- newNames                                  
      emptyTbl(tmp)   
    }
  })
  
  output$delSeries1 <- 
    renderUI(
      selectInput("delSeries2", 
                  label = NULL,
                  choices = colnames(hot_to_r(input$hottable)), 
                  selected = "", width = '100px',
                  multiple = TRUE)
      )
  
  outputOptions(output, 'hottable', suspendWhenHidden = FALSE) 
  
}

shinyApp(ui,server)

CodePudding user response：

I know this bug. Here is the fix:

output$hottable <- renderRHandsontable({
  rhandsontable(emptyTbl(), rowHeaderWidth = 100, useTypes = TRUE)%>%
    hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) %>%
    hot_cols(colWidths = 80) %>%
    htmlwidgets::onRender(
      "function(el, x){
        var hot = this.hot;
        $('a[data-value=\"Slave table\"').on('click', function(){
          setTimeout(function(){ hot.render(); }, 200);
        }); 
      }"
    )
})

Not sure the 200 milliseconds in setTimeout are necessary.