Problems with shiny::updateDateRangeInput()

Question

I have a set of data with different date ranges for different locations. I would like my date range widget to update the minimum and maximum dates after selecting a location with the select box widget.

I have tried the steps mentioned in https://mastering-shiny.org/action-dynamic.html#hierarchical-select and have modified it for the date range widget but it does not seem to be working. I have included a reprex below where the start date doesn't seem to update after selecting locations B or C but not A.


# Loading up packages required ----

packages <-
  c("data.table", "lubridate", "magrittr", "stringr", "shiny")

invisible(lapply(packages, library, character.only = TRUE))

rm(packages)

# Dummy data ----

set.seed(5L)

dummy_data <- data.table(
  location = c(rep("A", 10L),
               rep("B", 5L),
               rep("C", 3L)),
  date = c(
    seq.Date(Sys.Date() - 10L, by = 1L, length.out = 10L),
    seq.Date(Sys.Date() - 5L, by = 1L, length.out = 5L),
    seq.Date(Sys.Date() - 3L, by = 1L, length.out = 3L)
  ),
  counts = round(runif(18L) * 10L, digits = 0L)
)

# Define UI ----
ui <- fluidPage(

  sidebarLayout(

    sidebarPanel(
      h3('Filtering Criteria'),
      selectInput("location", label = h4('Location'), 
                  choices = c("All", unique(dummy_data$location))),
      dateRangeInput("date_range",
                     label = h4('Date Range (YYYY-MM-DD)'),
                     min = min(dummy_data$date),
                     start = min(dummy_data$date),
                     max = max(dummy_data$date),
                     end = max(dummy_data$date))
    ),

    mainPanel(
      h4('Dashboard'),
      tableOutput("data")
    )

  )

)

# Define server logic ----
server <- function(input, output, session) {

  # Filter location
  location_filter <- reactive({
    if (input$location == "All") {
      dummy_data
    } else {
      dummy_data[location == input$location]
    }
  })
  observeEvent(location_filter(), {
    updateDateRangeInput(session,
                         "date_range",
                         min = min(location_filter()$date),
                         start = min(location_filter()$date),
                         end = max(location_filter()$date),
                         max = max(location_filter()$date))
  })

  # Table Output
  output$data <- renderTable({
    location_filter() %>%
      .[date >= input$date_range[1] & date <= input$date_range[2]] %>%
      .[, date := as.character(date)]
  })

}

# Run the app ----
shinyApp(ui = ui, server = server)

I am very new to shiny as I've just picked it up 2-3 weeks ago so please be gentle with me if it's a noob mistake.

Thank you! It's actually exactly the same as the script for the dashboard without a few packages not required for this part and the addition of the dummy data. — EdTeD

Limey Limey · Accepted Answer · 2020-06-03T11:24:42

The problem seems to be with setting min/start or max/end at the same time. You have to ensure that start and end both lie within the range [min and max] at all times. The easiest way to do this was to split the update into stages:

Set min and max to the earlest and latest dates in the whole dataset
Set start and min to earliest and latest dates at the current location
Set min and max to the earliest and latest dates at the current location

I combined 1 and 2 in a single call to updateDateRangeInput.

It's messy, but it seems to work.

I changed the structure of your reactives slightly whilst investigating whether there was priority issue with their updates. Here's the whole server function.

server <- function(input, output, session) {
  locationData <- reactive({
    if (input$location == "All") {
      dummy_data
    } else {
      dummy_data[location == input$location]
    }

  })

  filteredData <- reactive({
    locationData() %>%
      .[date >= input$date_range[1] & date <= input$date_range[2]] %>%
      .[, date := as.character(date)]
  })

  # Filter location
  observeEvent(input$location, {
    updateDateRangeInput(session,
                         "date_range",
                         min = min(dummy_data$date),
                         max = max(dummy_data$date),
                         start = min(locationData()$date),
                         end = max(locationData()$date))
    updateDateRangeInput(session,
                         "date_range",
                         min = min(locationData()$date),
                         max = max(locationData()$date))
  })
  # Table Output
  output$data <- renderTable({
    filteredData()
  })
}

I'd be tempted to post this as an issue with Rstudio to see if this is expected behaviour.

Problems with shiny::updateDateRangeInput()

1 Answers