独立标签页hottable启用outputOptions后渲染异常的修复咨询

问题说明 #

启用outputOptions(output, 'hottable', suspendWhenHidden = FALSE)后，“Slave table”标签页中的hottable无法正常渲染；注释该函数则渲染正常，但此函数是实现hottable完全依赖“Master table”标签页增删列操作的核心，且操作按钮必须与hottable分属不同标签页，需实现无需点击即可让hottable正常渲染的效果。

问题根源 #

初始化阶段“Slave table”标签未激活，input$hottable尚未生成，但代码中多个逻辑（添加列、生成删除列选择框）直接调用hot_to_r(input$hottable)转换表格数据，触发报错导致hottable渲染失败。

修复步骤 #

• 统一使用emptyTbl()这个reactiveVal作为表格数据的唯一数据源，避免直接依赖未初始化的input$hottable
• 所有涉及表格列数、列名的操作，均从emptyTbl()中读取数据，不再通过input$hottable转换

修复后完整代码 #

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))
    # 从emptyTbl获取当前列数，不再依赖input$hottable
    names(newCol) <- paste("Series", ncol(emptyTbl()) + 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,
                  # 从emptyTbl获取列名，不再依赖input$hottable
                  choices = colnames(emptyTbl()), 
                  selected = "", width = '100px',
                  multiple = TRUE)
    )
  
  outputOptions(output, 'hottable', suspendWhenHidden = FALSE) 
  
}

shinyApp(ui,server)

内容的提问来源于stack exchange，提问作者Village.Idyot