R Shiny：在动态情况下有条件地更新可能的用户输入选择

Question

我创建了一个微型 Shiny 应用程序，其中询问用户 s/he 想要切割给定的日期向量（2 到 4 之间）的周期数。然后，对于用户想要的每个时间段（最后一个除外）s/he 被要求 select 该时间段的最后日期。

该应用程序正在运行，但是，我担心某些愚蠢的用户可能 select 不是增量的结束日期，例如，select 时间段 1 的结束日期可能会晚些时候时间比结束日期selected for Time Period 2, etc.

换句话说，我希望在将 cutpoint2 定义为仅包含 cutpoint1 日期之后的日期等时为用户提供选择（日期）。因此，如果用户 selected ' 2006-12-31' 作为时间段 1 的结束日期，我希望时间段 2 的用户输入框可用的日期在该日期之后开始。

但是，我不确定在这种超级动态的情况下是否可行，因为首先，我第一次创建了这些切点输入 - 当用户根本没有被问及日期时，所以我可以让他们真正地相互依赖。然后我要求用户定义切点 - 然后我希望该动态开始。

感谢您的建议！

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

将此插入到您的服务器函数中：

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)]]])
      }
    }
})

由于您的 lapply 每当您增加周期数时您都会创建新的 selectInput ，您（无意中）覆盖以前的结果并重置开始周期，每当用户从例如3 到 4 个切点周期。

R Shiny：在动态情况下有条件地更新可能的用户输入选择

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

r

shiny

conditional