仅在dateRangeInput或dateInput中显示月份,用于闪亮的应用程序[R编程]

ruarlubt  于 2023-04-27  发布在  其他
关注(0)|答案(4)|浏览(109)

我正在使用shiny创建一个网络应用程序。我的一个图只使用特定年份的几个月来生成图中的点。
我希望用户只选择月份。虽然我已经提到了
dateInputdateRangeInput中的format = 'mm-yyyy'startview = 'year'
每当用户点击日期输入字段时,用户将被显示月份,然后在点击任何月份时,用户将被显示月份中的日期。
我希望用户被显示到月份。如果用户点击月份的日期不应该被显示。
如何才能做到这一点?

ux6nzvsh

ux6nzvsh1#

我不相信dateInput已经实现了引导minViewMode选项作为函数参数,所以我在我自己的函数副本中添加了它(见下文)。我不得不添加一些其他必需的函数。这不是很好。最好的选择可能是向RStudio提交请求,因为添加这个minviewmode选项似乎很简单。

mydateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
                      format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en", minviewmode="months",
                      width = NULL) {
  
  # If value is a date object, convert it to a string with yyyy-mm-dd format
  # Same for min and max
  if (inherits(value, "Date"))  value <- format(value, "%Y-%m-%d")
  if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
  if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
  
  htmltools::attachDependencies(
    tags$div(id = inputId,
             class = "shiny-date-input form-group shiny-input-container",
             style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
             
             controlLabel(inputId, label),
             tags$input(type = "text",
                        # datepicker class necessary for dropdown to display correctly
                        class = "form-control datepicker",
                        `data-date-language` = language,
                        `data-date-weekstart` = weekstart,
                        `data-date-format` = format,
                        `data-date-start-view` = startview,
                        `data-date-min-view-mode` = minviewmode,
                        `data-min-date` = min,
                        `data-max-date` = max,
                        `data-initial-date` = value
             )
    ),
    datePickerDependency
  )
}

`%AND%` <- function(x, y) {
  if (identical(!is.null(x), !is.na(x)))
    if (identical(!is.null(y), !is.na(y)))
      return(y)
  return(NULL)
}

controlLabel <- function(controlName, label) {
  label %AND% tags$label(class = "control-label", `for` = controlName, label)
}

datePickerDependency <- htmlDependency(
  "bootstrap-datepicker", "1.0.2", c(href = "shared/datepicker"),
  script = "js/bootstrap-datepicker.min.js",
  stylesheet = "css/datepicker.css")
cidc1ykv

cidc1ykv2#

@MartinJohnHadley:基本上通过添加相同的三行@StevenMortimer添加到dateInput的代码到dateRangeInput。这将minViewMode添加到shinys dateRangeInput。
1.在https://github.com/rstudio/shiny/blob/master/R/input-daterange.R上找到代码
1.添加默认参数minviewmode="months"
1.将data-date-min-view-mode = minviewmode添加到两个div
1.添加缺少的参数(在github存档中搜索shiny)
1.享受您的自定义dateRange输入:-)
最好的问候sandro
验证码:

dateRangeMonthsInput <- function(inputId, label, start = NULL, end = NULL,
                            min = NULL, max = NULL, format = "yyyy-mm-dd", startview = "month",
                            minviewmode="months", # added manually
                            weekstart = 0, language = "en", separator = " to ", width = NULL) {
   
   # If start and end are date objects, convert to a string with yyyy-mm-dd format
   # Same for min and max
   if (inherits(start, "Date"))  start <- format(start, "%Y-%m-%d")
   if (inherits(end,   "Date"))  end   <- format(end,   "%Y-%m-%d")
   if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
   if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
   
   htmltools::attachDependencies(
     div(id = inputId,
         class = "shiny-date-range-input form-group shiny-input-container",
         style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
         
         controlLabel(inputId, label),
         # input-daterange class is needed for dropdown behavior
         div(class = "input-daterange input-group",
             tags$input(
               class = "input-sm form-control",
               type = "text",
               `data-date-language` = language,
               `data-date-weekstart` = weekstart,
               `data-date-format` = format,
               `data-date-start-view` = startview,
               `data-date-min-view-mode` = minviewmode, # added manually
               `data-min-date` = min,
               `data-max-date` = max,
               `data-initial-date` = start
             ),
             span(class = "input-group-addon", separator),
             tags$input(
               class = "input-sm form-control",
               type = "text",
               `data-date-language` = language,
               `data-date-weekstart` = weekstart,
               `data-date-format` = format,
               `data-date-start-view` = startview,
               `data-date-min-view-mode` = minviewmode, # added manually
               `data-min-date` = min,
               `data-max-date` = max,
               `data-initial-date` = end
             )
         )
     ),
     datePickerDependency
   )
 }
 
 `%AND%` <- function(x, y) {
   if (identical(!is.null(x), !is.na(x)))
     if (identical(!is.null(y), !is.na(y)))
       return(y)
   return(NULL)
 }
 
 controlLabel <- function(controlName, label) {
   label %AND% tags$label(class = "control-label", `for` = controlName, label)
 }
 
 # the datePickerDependency is taken from https://github.com/rstudio/shiny/blob/master/R/input-date.R
 datePickerDependency <- htmltools::htmlDependency(
 "bootstrap-datepicker", "1.6.4", c(href = "shared/datepicker"),
 script = "js/bootstrap-datepicker.min.js",
 stylesheet = "css/bootstrap-datepicker3.min.css",
 # Need to enable noConflict mode. See #1346.
 head = "<script>
 (function() {
 var datepicker = $.fn.datepicker.noConflict();
 $.fn.bsDatepicker = datepicker;
 })();
 </script>")
uhry853o

uhry853o3#

下面是另一个方法(代码冗余更少,希望更简单),由同事贡献。与复制shiny::dateInput函数代码不同,可以在之后将min/max-view-mode部分添加到Shiny对象中。然后可以按预期使用旧参数'startview'和新的'minview'/'maxview':

dateInput2 <- function(inputId, label, minview = "days", maxview = "decades", ...) {
  d <- shiny::dateInput(inputId, label, ...)
  d$children[[2L]]$attribs[["data-date-min-view-mode"]] <- minview
  d$children[[2L]]$attribs[["data-date-max-view-mode"]] <- maxview
  d
}

dateRangeInput2 <- function(inputId, label, minview = "days", maxview = "decades", ...) {
  d <- shiny::dateRangeInput(inputId, label, ...)
  d$children[[2L]]$children[[1]]$attribs[["data-date-min-view-mode"]] <- minview
  d$children[[2L]]$children[[3]]$attribs[["data-date-min-view-mode"]] <- minview
  d$children[[2L]]$children[[1]]$attribs[["data-date-max-view-mode"]] <- maxview
  d$children[[2L]]$children[[3]]$attribs[["data-date-max-view-mode"]] <- maxview
  d
}

下面是一个简单的例子:

library(shiny)
shinyApp(
  ui = fluidPage(
    dateInput2("test1", "Year", startview = "year", minview = "months", maxview = "decades"),
    dateRangeInput2("test2", "Years", startview = "year", minview = "months", maxview = "decades")
  ),
  server = function(input, output, session) {}
)

更新:

为了解决下面darKnight的问题,我扩展了这个例子,并引入了一个参数来设置最大可选时间分辨率。有关可能参数的完整列表,请参阅:
https://bootstrap-datepicker.readthedocs.io/en/latest/options.html

dldeef67

dldeef674#

想使用上一个答案中的代码的人:您需要使用更新的datePickerDependecy(可以从https://github.com/rstudio/shiny/blob/master/R/input-date.R获取)。
目前它是:

datePickerDependency <- htmlDependency(
"bootstrap-datepicker", "1.6.4", c(href = "shared/datepicker"),
script = "js/bootstrap-datepicker.min.js",
stylesheet = "css/bootstrap-datepicker3.min.css",
# Need to enable noConflict mode. See #1346.
head = "<script>
(function() {
var datepicker = $.fn.datepicker.noConflict();
$.fn.bsDatepicker = datepicker;
})();
</script>")

我把这句话作为回答,由于没有足够的声誉:(

相关问题