R Shiny日期范围输入仅限月份和年份。

Question

是否有一种方法可以在Shiny中黑客或创建dateRangeInput()选择器，以便仅选择月份-年份（无日期），或者自动选择所选月份的第一天而不显示日期选择？ 或者我应该创建另一个月份日期选择器（滑块，选择框...）

dateRangeInput('dateRange',label = "Pédiode d'analyse : ",format = "mm/yyyy",language="fr",
    start = Sys.Date() %m-% months(12), end=Sys.Date(),startview = "year",separator = " - ")

我希望的是在选择日期时删除这一步骤：dateRangeInput

- TiFr3D

Answer 1

我刚刚使用airDatePicker()来完成这个操作。您可以编辑弹出日历的最小视图为“月”，并选择日期格式为“yyyy-mm”。

airDatepickerInput("input_var_name",
                   label = "Start month",
                   value = "2015-10-01",
                   maxDate = "2016-08-01",
                   minDate = "2015-08-01",
                   view = "months", #editing what the popup calendar shows when it opens
                   minView = "months", #making it not possible to go down to a "days" view and pick the wrong date
                   dateFormat = "yyyy-mm"
                   )

我刚刚在工作的版本看起来是这样的（灰色的 5 月份是我截图时指针所在的位置）：

- aclong

Answer 2

请查看下面的自定义函数monthStart，它可以用来将日期强制为该月和年份的第一天。 示例1，显示给定月份的第一天。如果您希望在应用程序中稍后使用日期对象，则这可能很有用，因此它将始终指向给定月份和年份的第一天。

#rm(list=ls())
library(shiny)

monthStart <- function(x) {
  x <- as.POSIXlt(x)
  x$mday <- 1
  as.Date(x)
}

ui <- basicPage(dateRangeInput('dateRange',label = "Pédiode d'analyse : ",format = "mm/yyyy",language="fr",start = Sys.Date(), end=Sys.Date(),startview = "year",separator = " - "),
                textOutput("SliderText")
)
server <- shinyServer(function(input, output, session){

  Dates <- reactiveValues()
  observe({
    Dates$SelectedDates <- c(as.character(monthStart(input$dateRange[1])),as.character(monthStart(input$dateRange[2])))
  })
  output$SliderText <- renderText({Dates$SelectedDates})
})
shinyApp(ui = ui, server = server)

示例2，仅显示月份和年份

请注意：本文由机器翻译生成，可能存在语言表达上的不准确和易读性差等问题。

#rm(list=ls())
library(shiny)

monthStart <- function(x) {
  x <- as.POSIXlt(x)
  x$mday <- 1
  as.Date(x)
}

ui <- basicPage(dateRangeInput('dateRange',label = "Pédiode d'analyse : ",format = "mm/yyyy",language="fr",start = Sys.Date(), end=Sys.Date(),startview = "year",separator = " - "),
                textOutput("SliderText")
)
server <- shinyServer(function(input, output, session){

  Dates <- reactiveValues()
  observe({
    Dates$SelectedDates <- c(as.character(format(input$dateRange[1],format = "%m/%Y")),as.character(format(input$dateRange[2],format = "%m/%Y")))
  })
  output$SliderText <- renderText({Dates$SelectedDates})
})
shinyApp(ui = ui, server = server)

- Pork Chop

---

好的，但我不希望用户认为已选择了一天，也许实现这一点的最佳方法是创建一个滑块或具有mm-yyyy的selectinput。 - TiFr3D

由于我不知道您想如何使用此功能，因此我也包括了日期，因为在您的分析中可能需要它。为了显示方便，您可以只呈现日期而不包括星期几。请参见上面的更新。 - Pork Chop

抱歉我没有解释清楚，我已经添加了一张图片来展示我想要删除或隐藏的步骤。 - TiFr3D

在这种情况下，您应该使用定制的文本输入。 - Pork Chop

Answer 3

不确定它是否仍然相关，但我最近在寻找类似的东西并找到了这个解决方案

library(shiny)
library(shinyjs)
library(purrr)
library(tibble)
library(stringr)
library(lubridate)
library(reactable)

dates = seq.Date(from = as_date("2022-01-01"), to = as_date("2023-02-01"), by = "month")
labels = paste(month(c(as_date(dates)), label = T), year(c(as_date(dates))))
df = tibble(date = dates, letters = letters[1:14])

ui = fluidPage(
  
  tags$head(tags$style(HTML(".selected {background: rgba(125, 181, 171, .25);}")), shinyjs::useShinyjs()),
  
  div(style = "margin-top: 50px; display: flex; flex-direction: column; gap: 20px; align-items: center;",
  div(style = "display: flex; gap: 1rem;",    
      pmap(
        .l = list(
          dates = dates, 
          labels = labels, 
          classes = c(rep("", 3), rep("selected", 4), rep("", 7))), .f = ~actionButton(inputId = paste0("btn_", ..1), label = ..2) %>%tagAppendAttributes(class = ..3))),
  reactableOutput(outputId = "table"))
  
)

server = function(input, output, session){
  
  range = reactiveValues(from = "2022-04-01", to = "2022-07-01")
  
    map(paste0("btn_", dates), .f = function(x) {
      
      observeEvent(input[[x]], {
        
        freezeReactiveValue(input, "from")
        freezeReactiveValue(input, "to")
        
        val = str_remove(x, pattern = "btn_")
        
        if(!is_null(range$to)){
          
          range$from = val
          range$to = NULL
          
        }else if(is_null(range$to)){
          
          if(val > range$from){
            
            range$to = val
            
          }else if(val < range$from){
            
            range$to = range$from
            range$from = val
            
          }else if(val == range$from){
            
            range$to = NULL
            
          }
        }
        
        dateseq = if(is_null(range$to)){as_date(range$from)}else{seq.Date(as_date(range$from), as_date(range$to), by = "month")}
        map(.x = paste0("btn_", dates)[!paste0("btn_", dates)%in%paste0("btn_", dateseq)], .f = ~shinyjs::removeClass(id = .x, class = "selected"))
        map(.x = paste0("btn_", dateseq), .f = ~shinyjs::addClass(id = .x, class = "selected"))
        
    })
  })
    
  output$table = renderReactable({
    
    datevalues = if(is_null(range$to)){c(range$from, range$from)}else{c(range$from, range$to)}
    
    reactable(df[df$date>=as_date(datevalues[1])&df$date<=as_date(datevalues[2]),], defaultPageSize = 14)
    
  })  
}
shinyApp(ui, server)

- lucaskr

---

目前你的回答不够清晰，请编辑并添加更多细节，以帮助其他人理解它如何回答问题。你可以在帮助中心找到有关如何编写好答案的更多信息。 - Community