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

Question

我有一个闪亮的应用程序，当用户选择 Jan 1 和 Q2 如果用户选择 Apr 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)

编辑：

我也尝试将所有内容放在一个响应式中，但现在我得到一个长度为零的 agument：

    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, "^.."))
            }
    })

Answer 1

可以用as.yearqtr 简化，从zoo 转换为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. 当我们调用反应式的输出时，使用()。在下面的代码中，它被删除为单个反应式
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, "^.."))
     }
     
  })
  
}

-输出