CODEWITHSUNDEEP
rshinyconditional-statements
user3245256
user3245256

Reputation: 1948

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

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, e.g., 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)

Upvotes: 1

Views: 344

Answers (1)

John Nielsen
John Nielsen

Reputation: 194

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 e.g. 3 to 4 cutpoint periods.

Upvotes: 1

Related Questions