![](/img/trans.png)
[英]R: transforming character to date with only year and month to apply a dateRange input on a boxplot output in a Shiny app
[英]R Shiny DateRange Input month year only
有没有办法在 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
看看下面这个自定义函数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)
我刚刚使用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"
)
我刚刚处理的版本看起来像这样(灰色可能是我截取屏幕截图时光标悬停的地方):
不确定是否仍然相关,但我最近正在寻找类似的东西并来到这个解决方案
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)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.