Shiny应用dateRangeInput为空时崩溃的修复方案咨询

问题根源 #

当选择"choice 1"或"choice 3"时，手动清空dateRangeInput后，input$dates会返回c(NA, NA)而非NULL。原代码仅用!is.null(input$dates)判断，会继续执行seq()函数，但NA无法转换为有效日期，触发Error in seq.int: 'to' must be a finite number错误，直接导致应用崩溃。

修复方案 #

核心是在处理日期范围前，先验证两个日期值都不为NA，而非仅检查是否为NULL。同时优化日期转换的安全性，避免无效日期格式引发的潜在问题。

修复后的完整代码 #

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

df <- data.table(
  dasa = as.character(c("01/01/2020")),
  nasa = as.numeric(0),
  casa = as.character(c("")),
  stringsAsFactors = FALSE
)

cc <- strsplit(df$dasa,"/",fixed=TRUE)
d <- unlist(cc)[3*(1:length(df$dasa))-2]
m <- unlist(cc)[3*(1:length(df$dasa))-1]
y <- unlist(cc)[3*(1:length(df$dasa))]
df$das <- paste0(y,"-",m,"-",d)

ui <- dashboardPage(
  dashboardHeader(title = "Financial Statements"),
  dashboardSidebar(
    menuItem("Home", tabName = "home"),
    menuItem("Accounting", tabName = "Recognition",
             menuSubItem("item1", tabName = "Item1")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "Item1",
        fluidRow(
          column(
            width = 6,
            "Trial1_col1",
            rHandsontableOutput("Trial1_Item1")
          ),
          column(
            width = 6,
            "Trial1_col2",
            selectInput("choices", "Choose an option:",
                        choices = c("choice 1", "choice 2", "choice 3")),
            uiOutput("nested_ui")
          ),
          column(
            width = 6,
            "Trial1_col3",
            rHandsontableOutput("Trial1_Item2")
          )
        )
      )
    )
  )
)

server <- function(input, output, session) {
  data <- reactiveValues()

  observe({
    data$df <- as.data.frame(df)
  })

  observe({
    if (!is.null(input$Trial1_Item1)) {
      dfa <- hot_to_r(input$Trial1_Item1)
      cc <- strsplit(dfa$dasa,"/",fixed=TRUE)
      d <- unlist(cc)[3*(1:length(dfa$dasa))-2]
      m <- unlist(cc)[3*(1:length(dfa$dasa))-1]
      y <- unlist(cc)[3*(1:length(dfa$dasa))]
      dfa$das <- paste0(y,"-",m,"-",d)

      data$df <- dfa

      # 检查日期范围是否有效（无NA）
      if (!is.null(input$dates) && all(!is.na(input$dates))) {
        df1 <- data$df
        # 用lubridate的dmy安全转换日期，避免格式错误
        start_date <- dmy(input$dates[1])
        end_date <- dmy(input$dates[2])
        if (is.finite(start_date) && is.finite(end_date)) {
          selected_dates <- seq(start_date, end_date, by = "day")
          data$df2 <- df1[as.Date(df1$das) %in% selected_dates, ]
        } else {
          # 日期格式无效时返回全部数据
          data$df2 <- dfa
        }
      } else {
        # 日期范围为空或无效时返回全部数据
        data$df2 <- dfa
      }
    }
  })

  observe ({ 
    if (!is.null(input$text) && input$text != "") {
      updateTextInput(session, "text", value = input$text)
      data$df2 <- data$df[data$df$casa == input$text, ]
    }
  })

  observe({
    # 优先检查日期范围是否有效
    date_valid <- !is.null(input$dates) && all(!is.na(input$dates))
    text_valid <- !is.null(input$text) && input$text != ""
    
    if (date_valid && input$choices == "choice 3") {
      df1 <- data$df
      start_date <- dmy(input$dates[1])
      end_date <- dmy(input$dates[2])
      if (is.finite(start_date) && is.finite(end_date)) {
        selected_dates <- seq(start_date, end_date, by = "day")
        data$df2 <- df1[as.Date(df1$das) %in% selected_dates & df1$casa == input$text, ]
      } else {
        data$df2 <- data$df
      }
    } else if (date_valid) {
      df1 <- data$df
      start_date <- dmy(input$dates[1])
      end_date <- dmy(input$dates[2])
      if (is.finite(start_date) && is.finite(end_date)) {
        selected_dates <- seq(start_date, end_date, by = "day")
        data$df2 <- df1[as.Date(df1$das) %in% selected_dates, ]
      } else {
        data$df2 <- data$df
      }
    } else if (text_valid) {
      data$df2 <- data$df[data$df$casa == input$text, ]
    } else {
      data$df2 <- data$df
    }
  })

  observe({
    if (!is.null(input$Trial1_Item2)) {
      data$df2 <- hot_to_r(input$Trial1_Item2)
    }
  })

  output$Trial1_Item1 <- renderRHandsontable({
    rhandsontable(data$df[,c(1:3)], stretchH = "all", rowHeaderWidth = 50, height = 300) |>
      hot_col(1, format = "%d/%m/%Y", type = "date")
  })

  output$nested_ui <- renderUI({
    if (input$choices == "choice 1") {
      dateRangeInput("dates", "Select a date range:", format = "dd/mm/yyyy",
                     start = "2000-01-01", end = Sys.Date())
    } else if (input$choices == "choice 2") {
      textInput("text", "Enter some text:")
    } else if (input$choices == "choice 3") {
      fluidRow(
        dateRangeInput("dates", "Select a date range:", format = "dd/mm/yyyy",
                       start = "2000-01-01", end = Sys.Date()),
        textInput("text", "Enter some text:")
      )
    }
  })

  output$Trial1_Item2 <- renderRHandsontable({
    rhandsontable(data$df2[,c(1:3)], stretchH = "all", rowHeaderWidth = 50, height = 300) |>
      hot_col(1, format = "%d/%m/%Y", type = "date")
  })
}

shinyApp(ui, server)

关键修改点 #

1. 日期有效性检查：将原有的!is.null(input$dates)替换为!is.null(input$dates) && all(!is.na(input$dates))，确保两个日期都不为空。
2. 安全日期转换：使用lubridate::dmy()转换输入日期，同时用is.finite()验证转换后的日期是否有效，避免无效格式引发错误。
3. 异常分支处理：当日期无效或为空时，默认返回全部数据，保证应用不会崩溃。

验证方法 #

选择"choice 1"或"choice 3"，手动清空日期范围输入框，应用不会崩溃，右侧表格会显示全部数据；输入有效日期范围后，仍能正常过滤数据。

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