Shiny中使用sliderTextInput按日期过滤出现charToDate错误

问题根源 #

Shiny的输入控件会把sliderTextInput里的choices（哪怕你传入的是yearmon对象）转成字符串格式传到server端，不会保留原yearmon对象类型。比如你选的"2007-2-1"对应的yearmon会变成类似"Feb 2007"的字符串，直接用as.Date()解析这种非标准日期字符串，就会触发charToDate()的格式报错。

而你在Shiny外测试时，直接用as.yearmon()生成的是原生yearmon对象，as.Date()能正确处理，但到了Shiny里拿到的是字符串，原来的逻辑自然失效。

修复方案 #

在server端，先把输入的字符串转回yearmon对象，再转成Date类型做过滤：

server <- function(input, output, session) {
  output$show_dates <- renderTable({
    # 先转yearmon再转Date
    start_date <- as.Date(as.yearmon(input$select_dates[1]))
    df %>% filter(date >= start_date)
  })
}

完整可运行代码 #

library(shiny)
library(tidyverse)
library(zoo)
library(shinyWidgets)

df <- tibble(a = 1:3, 
             date = as.Date(c("2007-1-1", "2007-2-1", "2007-3-1"))
             )

ui <- fluidPage(
  shinyWidgets::sliderTextInput("select_dates", NULL,
                                choices = as.yearmon(df$date),
                                selected = as.yearmon(c("2007-1-1", 
                                                        "2007-2-1")),
                                animate = TRUE,
                                grid = FALSE,
                                dragRange = TRUE),
  tableOutput("show_dates")
)

server <- function(input, output, session) {
  output$show_dates <- renderTable({
    start_date <- as.Date(as.yearmon(input$select_dates[1]))
    df %>% filter(date >= start_date)
  })
}

shinyApp(ui = ui, server = server)

扩展：处理日期范围两端 #

如果要同时用滑块的起始和结束值过滤，逻辑一样：

server <- function(input, output, session) {
  output$show_dates <- renderTable({
    start_date <- as.Date(as.yearmon(input$select_dates[1]))
    end_date <- as.Date(as.yearmon(input$select_dates[2]))
    df %>% filter(date >= start_date, date <= end_date)
  })
}

内容的提问来源于stack exchange，提问作者Dataguy4583