如何忽略会导致R Shiny应用崩溃的用户输入？

问题背景 #

该Shiny应用实现以下功能：用户在父表格parentTbl输入值，通过下方的X/Y子表格调整数据生成曲线。但在特定场景下会崩溃：当用户给X/Y子表格添加行并留空新行后，拖动input$periods滑块时，偶尔触发崩溃，且会话持续越久概率越高。控制台报错为：

Warning: Error in .rowNamesDF<-: invalid 'row.names' length
或
Warning: non-unique value when setting 'row.names': ‘2’
Warning: Error in .rowNamesDF<-: duplicate 'row.names' are not allowed

需求：在R Shiny中实现忽略当前导致崩溃的无效输入，自动回退到上一次的有效输入状态。

解决方案 #

核心思路是通过输入校验和错误捕获，避免无效数据进入反应式逻辑，同时在出错时保留之前的有效状态：

• 用tryCatch包裹可能出错的代码块，捕获错误时不更新反应式变量，维持原有有效数据。
• 对用户输入的子表格数据做预处理：移除空行、确保X列值唯一且在允许范围内，从源头避免无效数据。
• 初始化反应式变量时设置有效默认值，避免空值引发的异常。

修改后的完整代码 #

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  sliderInput("periods", "时间窗口(W):", min = 1, max = 10, value = 5),
  h5(strong("窗口(W)内的变量(Y):")),
  rHandsontableOutput("parentTbl"),  
  uiOutput("childTbl")
)

server <- function(input, output, session) {
  numVars <- 2  # 要建模的变量数量
  parentVars <- lapply(1:numVars, function(i) { reactiveValues(data = 20) })
  
  output$parentTbl <- renderRHandsontable({
    rhandsontable(
      data.frame(Inputs = sapply(parentVars, function(x) x$data)),
      readOnly = FALSE,
      colHeaders = c('输入值'),
      rowHeaders = paste0("变量 ", LETTERS[1:numVars]),
      contextMenu = FALSE
    )
  })
  
  observeEvent(input$parentTbl, {
    newValues <- hot_to_r(input$parentTbl)$Inputs
    for (i in 1:numVars) {
      parentVars[[i]]$data <- newValues[i]
    }
  })
  
  # 初始化反应式变量为有效默认数据
  reviseTbl <- lapply(1:numVars, function(i) { 
    reactiveVal(data.frame(X = 1, Y = parentVars[[i]]$data)) 
  })
  
  observeEvent(input$periods, {
    for (i in 1:numVars) {
      varInputId <- paste0("var_", i, "_input")
      
      # 用tryCatch捕获错误，出错时不更新状态
      tryCatch({
        reviseTable <- hot_to_r(input[[varInputId]])
        
        # 预处理：移除空行（X或Y为空的行）
        reviseTable <- reviseTable[!is.na(reviseTable$X) & !is.na(reviseTable$Y), ]
        # 过滤X超出当前时间窗口的行
        reviseTable <- subset(reviseTable, X <= input$periods & X >= 1)
        
        # 确保X值唯一，重复的只保留第一行
        if(nrow(reviseTable) > 0) {
          reviseTable <- reviseTable[!duplicated(reviseTable$X), ]
          # 重置行名避免重复
          rownames(reviseTable) <- NULL
        }
        
        # 确保至少保留一行有效数据
        if(nrow(reviseTable) == 0) {
          reviseTable <- data.frame(X = 1, Y = parentVars[[i]]$data)
        }
        
        reviseTbl[[i]](reviseTable)
      }, error = function(e) {
        # 出错时不更新，保留之前的有效数据
        message("忽略无效输入，维持上一次有效状态：", e$message)
      })
    }
  }, ignoreInit = TRUE)
  
  # 构建X/Y子表格
  lapply(1:numVars, function(i) {
    varInputId <- paste0("var_", i, "_input")
    output[[varInputId]] <- renderRHandsontable({
      df <- reviseTbl[[i]]()
      # 始终更新第一行的Y值为父表格的当前值
      if(nrow(df) > 0) {
        df[1, "Y"] <- parentVars[[i]]$data
      }
      
      rhandsontable(df, contextMenu = TRUE, minRows = 1, rowHeaders = FALSE) %>%
        hot_validate_numeric(col = 1, min = 1, max = input$periods)
    })
  })
  
  output$childTbl <- renderUI({
    lapply(1:numVars, function(i) {
      varInputId <- paste0("var_", i, "_input")
      list(
        h5(strong(paste("调整变量 ", LETTERS[i], " 在时间点X的Y值:"))),
        rHandsontableOutput(varInputId)
      )
    })
  })
}

shinyApp(ui, server)

关键修改点说明 #

1. 反应式变量初始化：reviseTbl初始化为包含有效默认行的数据框，避免空值引发的异常。
2. 输入预处理：在读取子表格数据后，移除空行、过滤超出范围的X值、去重X列，同时重置行名，从源头消除导致行名错误的因素。
3. 错误捕获：用tryCatch包裹数据处理逻辑，出错时仅打印错误信息，不更新反应式变量，自动保留上一次的有效状态。
4. 兜底逻辑：确保处理后的数据至少保留一行有效数据，避免空表格引发的渲染问题。

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