如何将日期范围输入转换为 R Shiny 中的字符串?

How to convert date range input into string in R Shiny?

我有一个闪亮的应用程序,当用户选择 1 月 1 日和 Q2(如果用户选择 4 月 1 日等)时,我想制作一个标题为“Q1”的标题,但由于某种原因,我无法转换日期字符范围输入。

例如,我知道这段代码适用于常规字符串:

 date <- "2020-10-01"
 
library(stringr)
libary(dplyr)
  date <- date %>%
   str_remove("^..") %>%
   str_replace_all("-", "/")
 
 starting <- if(str_detect(date, "../01/01")) {
   print("Q1")
 } else if(str_detect(date, "../04/01")){
   print("Q2")
 } else if(str_detect(date, "../07/01")){
   print("Q3")
 } else if(str_detect(date, "../10/01")){
   print("Q4")
 } else{
   paste0(str_extract(date, ".....$"), "/", str_extract(date, "^.."))
 }
 #Correctly says Q4
 starting

但是,当我尝试将它放入闪亮的应用程序中时,出现了各种错误,例如:

Warning: Error in cat: argument 1 (type 'closure') cannot be handled by 'cat'

如何让这个应用程序使用上面的代码来更改下面消息输出中呈现的文本?注意:为简单起见,我只处理日期过滤器中的第一个输入,但如果出于某种原因,第二个输入会有所不同,请告诉我我需要做什么。

library(shiny)
library(dplyr)
library(stringr)

ui <- fluidRow(
    column(12,
           div(id = "inputs",
               dateRangeInput(
                   inputId = "date_filter",
                   label = "Filter by Date",
                   start = "2020-01-01",
                   end = (today() + 90),
                   min = "2021-01-01",
                   max = NULL,
                   format = "yyyy-m-d",
                   startview = "month",
                   weekstart = 0,
                   language = "en",
                   separator = " to ",
                   width = NULL,
                   autoclose = TRUE
               )),
        textOutput("message")
    )
)

server <- function(input, output) {
    
    start_date <- reactive({input$datefilter[1]
        })
    
    start_date <- reactive({start_date %>%
        str_remove("^..") %>%
        str_replace_all("-", "/")
    })
    
    starting <- reactive({
        if(str_detect(start_date, "..../01/01")) {
            print("Q1")
        } else if(str_detect(start_date, "..../04/01")){
            print("Q2")
        } else if(str_detect(start_date, "..../07/01")){
            print("Q3")
        } else if(str_detect(start_date, "..../10/01")){
            print("Q4")
        } else{
            paste0(str_extract(start_date, ".....$"), "/", str_extract(start_date, "^.."))
        }
        })
    
    
    output$message <- renderText({
        starting
    })

}

shinyApp(ui = ui, server = server)

编辑:

我也试着把所有东西都放在一个反应​​式中,但现在我得到一个长度为零的 agrument:

    output$message <- renderText({
        
        start_date <- input$datefilter[1]
        
        start_date <- start_date %>%
                str_remove("^..") %>%
                str_replace_all("-", "/")
        
        starting <- 
            if(str_detect(start_date, "..../01/01")) {
                print("Q1")
            } else if(str_detect(start_date, "..../04/01")){
                print("Q2")
            } else if(str_detect(start_date, "..../07/01")){
                print("Q3")
            } else if(str_detect(start_date, "..../10/01")){
                print("Q4")
            } else{
                paste0(str_extract(start_date, ".....$"), "/", str_extract(start_date, "^.."))
            }
    })

可以用as.yearqtrzoo简化为yearqtr,然后用format只提取四分之一

server <- function(input, output) {
  
  
  
  
  output$message <- renderText({
    
    format(zoo::as.yearqtr(input$date_filter[1]), 'Q%q')
  })
  
}

shinyApp(ui = ui, server = server)

-输出


关于 OP 的代码,有几个问题

  1. datefilter 而不是 date_filter
  2. 当我们调用反应性使用的输出时()。在下面的代码中,它被删除为单个 reactive
  3. 在我们得到带有str_remove的子串后,使用....作为模式将不会匹配。应该是..
server <- function(input, output) {
  
  
  
 
  
  output$message <- renderText({
    
   req(input$date_filter[1])
    tmp <- as.character(input$date_filter[1]) %>%
      str_remove("^..") %>%
      str_replace_all("-", "/")
    
     if(str_detect(tmp, "../01/01")) {
       "Q1"
     } else if(str_detect(tmp, "../04/01")){
       "Q2"
     } else if(str_detect(tmp, "../07/01")){
       "Q3"
     } else if(str_detect(tmp, "../10/01")){
       "Q4"
     } else{
       paste0(str_extract(tmp, ".....$"), "/", str_extract(tmp, "^.."))
     }
     
  })
  
}

-输出