r - 如何将日期范围输入转换为 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, "^.."))
            }
    })

标签： rstringdateshinyreactive-programming

Answer 1

可以使用as.yearqtrfrom简化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，使用....as 模式将不匹配。它应该是..

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

-输出