跨tabPanel时rhandsontable响应异常：删除列致从属表崩溃

问题描述 #

运行两个可扩展的rhandsontable，要求始终保持相同列数与列标题，但行数据不同：

• 主表myDF1渲染为hottable1，位于"Master table"标签页，支持添加/删除列
• 从属表myDF2渲染为hottable2，位于单独的"Slave table"标签页，需同步主表的列数与列标题

当两表在同一tabPanel时联动正常，但分属不同tabPanel时：

• 列添加功能正常
• 在主表所在tab删除列时，从属表所在的"Slave"标签页会崩溃

问题原因 #

• 未激活Tab的Input值不存在：Shiny默认不会渲染未激活标签页中的输出组件，因此在未切换到"Slave table"标签页时，input$hottable2为NULL，直接调用hot_to_r(input$hottable2)会触发错误。
• 依赖错误的触发源：删除逻辑错误监听了下拉框的input$delSeries3而非删除按钮input$delSeries，导致下拉框选择变化时就触发删除操作，同时部分逻辑依赖未初始化的从表Input。
• 同步逻辑依赖不稳定的Input：添加列时使用input$hottable2的列数来生成新列名，而非基于主表的状态，在从表未激活时会出错。

修复后的代码 #

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

myDF1 <- data.frame('Series 1' = c(1,24,0), check.names = FALSE)
rownames(myDF1) <- c('Term A','Term B','Term C') 
myDF2 <- data.frame('Series 1' = c(20,15), check.names = FALSE)
rownames(myDF2) <- c('Boy','Girl') 

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

server <- function(input, output) {
  # 用reactiveVal存储当前表数据，替代直接依赖input$hottableX
  emptyTbl1 <- reactiveVal(myDF1)
  emptyTbl2 <- reactiveVal(myDF2)
  
  # 监听主表编辑，更新reactiveVal
  observeEvent(input$hottable1, {
    emptyTbl1(hot_to_r(input$hottable1))
  })
  
  # 监听从表编辑，更新reactiveVal（仅当从表激活时触发）
  observeEvent(input$hottable2, {
    emptyTbl2(hot_to_r(input$hottable2))
  })
  
  output$hottable1 <- renderRHandsontable({
    rhandsontable(emptyTbl1(), rowHeaderWidth = 100, useTypes = TRUE)%>%
      hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
  })
  
  output$hottable2 <- renderRHandsontable({
    rhandsontable(emptyTbl2(), rowHeaderWidth = 100, useTypes = TRUE)%>%
      hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
  })
  
  # 添加列：基于主表的reactiveVal状态，而非input$hottableX
  observeEvent(input$addSeries, {
    newColNum <- ncol(emptyTbl1()) + 1
    newCol1 <- data.frame(c(1,24,0))
    newCol2 <- data.frame(c(20,15))
    names(newCol1) <- paste("Series", newColNum)
    names(newCol2) <- paste("Series", newColNum)
    emptyTbl1(cbind(emptyTbl1(), newCol1))
    emptyTbl2(cbind(emptyTbl2(), newCol2))
  })
  
  # 删除列：监听删除按钮，基于主表的reactiveVal同步从表
  observeEvent(input$delSeries, {
    tmp1 <- emptyTbl1()                                     
    tmp2 <- emptyTbl2()                                       
    if(ncol(tmp1) > 1){
      delCol <- input$delSeries3                              
      if(!is.null(delCol)){
        tmp1 <- tmp1[ , !(names(tmp1) %in% delCol), drop = FALSE]  
        tmp2 <- tmp2[ , !(names(tmp2) %in% delCol), drop = FALSE]  
        newNames <- sprintf("Series %d", seq(1:ncol(tmp1)))        
        names(tmp1) <- newNames                                  
        names(tmp2) <- newNames                                  
        emptyTbl1(tmp1)                                         
        emptyTbl2(tmp2)   
      }
    }
  })
  
  # 生成删除列的下拉框：基于主表的reactiveVal，而非input$hottable1
  output$delSeries2 <- renderUI(
    selectInput("delSeries3", 
                label = NULL,
                choices = colnames(emptyTbl1()), 
                selected = "", width = '100px',
                multiple = TRUE)
  )
}

shinyApp(ui,server)

关键修复点 #

• 统一依赖reactiveVal：所有列操作（添加、删除、下拉框选项）都基于存储在emptyTbl1和emptyTbl2中的当前数据，而非直接依赖input$hottableX，避免未激活Tab导致的NULL错误。
• 修正删除触发源：删除操作改为监听删除按钮input$delSeries，而非下拉框的选择变化，符合用户点击删除才执行的预期。
• 添加空值判断：在删除逻辑中增加if(!is.null(delCol))，避免未选择列时触发错误。

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