По умолчанию updateDateInput не работает в будущем

Question

У меня есть простое приложение, использующее элемент пользовательского интерфейса Dynami c, updateDateInput, чтобы пользователь мог выбирать даты только в указанном году. Выбранная дата всегда должна по умолчанию соответствовать первому дню выбранного года.

library(shiny)
library(tidyverse)
library(lubridate)

ui <- fluidPage(
  selectInput("year", "Select Year:",
              choices = 2010:2020, selected = 2015),
  dateInput("date", "Select Date:", value = NULL)
)

server <- function(input, output, session) {
  observeEvent(input$year, 
               updateDateInput(session, "date", 
                               min = ymd(paste(input$year, "01-01", sep = "-")),
                               max = ymd(paste(input$year, "12-31", sep = "-")),
                               value = ymd(paste(input$year, "01-01", sep = "-"))))
}

shinyApp(ui, server)

При перемещении выбранного года назад (например, 2015 - 2014) выбранная дата автоматически обновляется до первого числа месяца. Однако, когда пользователь перемещает дату вперед, с 2015 на 2016, выбранная дата по умолчанию равна нулю, и пользователю необходимо вручную выполнить поиск, чтобы перейти к датам текущего года.

Может ли кто-нибудь помочь мне выяснить, почему это происходит?

Answer 1

Это неприятная проблема, и мне потребовались годы, чтобы разобраться, когда это случилось со мной. Проблема в том, что updateDateInput, похоже, вносит изменения, отличные от atomi c. То есть они возникают не сразу, а последовательно. Следовательно, при одновременном изменении более чем одного параметра виджета ввода возможно, что value на мгновение станет недействительным.

Хитрость заключается в том, чтобы убедиться, что выбранная дата действительна в любое время в течение Обновить. Это означает внесение изменений в два этапа и в порядке, который зависит от того, двигаетесь ли вы вперед или назад во времени.

Вот рабочее решение.

library(shiny)
library(tidyverse)
library(lubridate)

ui <- fluidPage(
  selectInput("year", "Select Year:",
              choices = 2010:2020, selected = 2015),
  dateInput("date", "Select Date:", value = NULL)
)

server <- function(input, output, session) {
  observeEvent(input$year, {
    req(input$date, input$year)
    
    # Are we going backwards or forwards?
    if (as.numeric(input$year > year(input$date))) {
      updateDateInput(
        session, 
        "date", 
        max = ymd(paste(input$year, "12-31", sep = "-")),
        value = ymd(paste(input$year, "01-01", sep = "-")),
      )
      updateDateInput(
        session, 
        "date", 
        min = ymd(paste(input$year, "01-01", sep = "-"))
      )
    } else {
      updateDateInput(
        session, 
        "date", 
        min = ymd(paste(input$year, "01-01", sep = "-")),
        value = ymd(paste(input$year, "01-01", sep = "-"))
      )
      updateDateInput(
        session, 
        "date", 
        max = ymd(paste(input$year, "12-31", sep = "-"))
      )
    }
  })
}

shinyApp(ui, server)