R Shiny整合日期校验与dateRangeInput触发.checkTypos错误排查

问题根源 #

应用崩溃的核心原因是**as.Date()在遇到非日期格式字符串时会抛出致命错误**，且原代码未添加任何错误捕获机制：

• 当在table1Item1的Date列输入非日期文本时，as.Date(data$df1$Date)直接触发报错，中断应用运行
• 原代码中的日期验证逻辑any(is.character(as.Date(...)))完全无效，因为as.Date转换失败时会直接报错，根本不会返回字符类型

解决方案 #

关键修改点 #

1. 添加日期合法性前置校验：用正则表达式匹配YYYY-MM-DD格式，仅对合法日期进行转换，非法内容保留原样
2. 修复数据同步逻辑：避免在多个observe中重复读取hot_to_r(input$table1Item1)，减少逻辑冲突
3. 筛选时跳过非法日期：在日期范围筛选时，临时生成转换后的日期列，自动排除转换失败的行，避免报错

修改后的完整代码 #

library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(shinyalert)

DF1 <- data.table(
  "Date" = as.character(NA),
  "Col2" = as.character(NA),
  stringsAsFactors = FALSE
)

DF2 <- data.table(
  "Date" = as.character(NA),
  "Col2" = as.character(NA),
  stringsAsFactors = FALSE
)

ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = NULL),
    dashboardSidebar(
      sidebarMenu(
        menuItem("reprex", tabName = "table1")
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName = "table1",
                fluidRow(
                  column(
                    width = 6,
                    label = NULL,
                    rHandsontableOutput("table1Item1")
                  ),
                  column(
                    width = 6,
                    "Choose btw Date and Col2",
                    selectInput("choices", label=NULL,
                                choices = c("Filter by Date", "Filter by Col2")),
                    uiOutput("nested_ui1")
                  ),
                  column(
                    width = 6,
                    label=NULL,
                    rHandsontableOutput("table1Item2")
                  )
                )
        )
      )
    )
  )
)

server = function(input, output, session) {
  
  data <- reactiveValues(df1 = as.data.table(DF1), df2 = as.data.table(DF2))
  
  # 处理handsontable输入，验证日期格式
  observeEvent(input$table1Item1, {
    if (!is.null(input$table1Item1)) {
      temp_df <- hot_to_r(input$table1Item1)
      
      # 校验Date列格式，仅保留合法的YYYY-MM-DD格式，非法的保留原内容
      date_pattern <- "^\\d{4}-\\d{2}-\\d{2}$"
      valid_dates <- grepl(date_pattern, temp_df$Date, perl = TRUE)
      # 对合法日期进行格式化，非法的保持原样
      temp_df$Date[valid_dates] <- format(as.Date(temp_df$Date[valid_dates], format = "%Y-%m-%d"), "%Y-%m-%d")
      
      data$df1 <- temp_df
    }
  })
  
  # 处理筛选逻辑
  observe({
    req(input$table1Item1)
    current_df <- data$df1
    
    if (input$choices == "Filter by Date" && !is.null(input$dates1) && !any(is.na(input$dates1))) {
      from <- as.Date(input$dates1[1L])
      to <- as.Date(input$dates1[2L])
      if (from > to) to <- from
      selectdates1 <- seq.Date(from = from, to = to, by = "day")
      
      # 仅转换合法日期进行筛选，非法日期的行直接排除
      current_df[, temp_date := as.Date(Date, format = "%Y-%m-%d")]
      data$df2 <- current_df[!is.na(temp_date) & temp_date %in% selectdates1, .(Date, Col2)]
      current_df[, temp_date := NULL]
    } else if (input$choices == "Filter by Col2" && !is.null(input$text)) {
      data$df2 <- current_df[Col2 == input$text, ]
    } else {
      data$df2 <- current_df
    }
  })
  
  output$table1Item1 <- renderRHandsontable({
    rhandsontable(data$df1, stretchH = "all", height = 300) |>
      hot_col(1, dateFormat = "YYYY-MM-DD", type = "date")
  })
  
  output$nested_ui1 <- renderUI({
    if (input$choices == "Filter by Date") {
      dateRangeInput("dates1", "Filter by Date:", format="yyyy-mm-dd",
                     start = Sys.Date(), end = Sys.Date(), separator = "-")
    } else if (input$choices == "Filter by Col2") {
      textInput("text", "Filter by Col2:")
    }
  })
  
  output$table1Item2 <- renderRHandsontable({
    rhandsontable(data$df2)
  })
  
}

shinyApp(ui, server)

核心修改说明 #

• 日期合法性校验：用正则表达式^\\d{4}-\\d{2}-\\d{2}$提前判断输入格式，仅对合法日期做格式化处理，非法内容保留原样
• 筛选错误规避：在筛选时临时生成temp_date列，转换失败的行自动标记为NA，筛选逻辑直接排除这些行，避免as.Date报错
• 简化初始化逻辑：直接在reactiveValues中初始化数据，去掉多余的observe
• 依赖校验：使用req()确保筛选逻辑仅在input$table1Item1存在时运行，避免空值触发的异常

内容的提问来源于stack exchange，提问作者firuz.safaev