R Shiny: conditional update of possible user input choices in a dynamic situation

Question

I've created a tiny Shiny app where the user is asked into how many periods s/he wants to cut a given vector of dates (between 2 and 4). Then, for each time period the user wants to have (except for the last one) s/he is asked to select the last date of that time period.

The app is working, however, I am afraid some foolish user might select end dates that are not incremental, eg, the selected end date for Time Period 1 might be later in time than the end date selected for Time Period 2, etc.

In other words, I'd love to make choices (dates) available to user while defining cutpoint2 to contain only dates that come AFTER the cutpoint1 date, etc. So, if the user selected '2006-12-31' as the end date for Time Period 1, I'd like the dates available for user input box for Time Period 2 to start AFTER that date.

However, I am not sure it's even possible in this super-dynamic situation because first, I create those cutpoint inputs for the first time - when the user hasn't even been asked about dates at all, so I can't make them really dependent on each other. And then I ask the user to define the cut points - and then I'd like that dynamic to kick in.

Appreciate your advice!

library(shiny)

ui = shinyUI(fluidPage(

  titlePanel("Defining time periods"),
  sidebarLayout(
    sidebarPanel(
      numericInput("num_periodsnr", label = "Desired number of time periods?",
                   min = 2, max = 4, value = 2),
      uiOutput("period_cutpoints"),
      actionButton("submit", "Update time periods")
    ),
    mainPanel(                       # Just shows what was selected
      textOutput("nr_of_periods"),
      textOutput("end_dates")
    )
  )
))

server = shinyServer(function(input, output, session) {

  library(lubridate)
  output$nr_of_periods <- renderPrint(input$num_periodsnr)

  # Dates string to select dates from:
  dates <- seq(ymd('2016-01-02'), ymd('2017-12-31'), by = '1 week')

  output$period_cutpoints <- renderUI({
    req(input$num_periodsnr)
    lapply(1:(input$num_periodsnr - 1), function(i) {
      selectInput(inputId = paste0("cutpoint", i), 
                  label = paste0("Select the last date of Time Period ", i, ":"),
                  choices = dates)
    })
  })

  dates_chosen <- reactiveValues(x = NULL)
  observeEvent(input$submit, {
    dates_chosen$x <- list()
    lapply(1:(input$num_periodsnr - 1), function(i) { 
      dates_chosen$x[[i]] <- input[[paste0("cutpoint", i)]]
    })
  })

  output$end_dates <- renderText({paste(as.character(dates_chosen$x), collapse = ", ")})
})

shinyApp(ui = ui, server = server)

Answer 1

Insert this into your server function:

observe({
    if(input$num_periodsnr > 2){
      for(i in 2:(input$num_periodsnr - 1)) {
        updateSelectInput(session, paste0("cutpoint", i), choices = dates[dates > input[[paste0("cutpoint", i-1)]]])
      }
    }
})

Due to your lapply where you make new selectInput whenever you increase the number of periods, you (unintenionally) overwrite the previous results and reset the starting period, whenever a user goes from eg 3 to 4 cutpoint periods.