Question

我有这个小的Shiny应用程序。

它首先要求用户确定他/他想要将日期向量分割成的周期数。因此，如果用户可能说：我想要3个时间段或4个时间段。

然后，他（她）应选择除最后一个时间段以外的所有时间段的结束日期（从固定的日期向量中）。但是，一旦用户选择了第一个时间段的结束日期，我希望第二个时间段的显示为“候选对象”的日期开始于第一个截止日期之后的日期，等等。

一切正常-但当用户选择4个时间段（或更长时间）时，一切都不正常。由于某些原因，如果是4个时间段，则不能自由选择第二个时间段的日期，并且停留在第一个时间段结束日期之后的值。

很明显，罪魁祸首是我最后的watch（{}）代码部分。我只是不明白为什么它可以工作2到3个时间段，但是在那之后会崩溃。

任何帮助将不胜感激！

library(shiny)
library(lubridate)

# In this app the user first selects the number of time periods s/he wants (x)
# And then for first x-1 time periods selects the end date of each time period

ui = shinyUI(fluidPage(

  titlePanel("Defining time periods"),
  sidebarLayout(
    sidebarPanel(
      numericInput("num_periodsnr", label = "Desired number of time periods?",
                   min = 2, max = 10, value = 2),
      uiOutput("period_cutpoints"),
      actionButton("submit", "Update time periods")
    ),
    mainPanel(                       # Just shows what was selected: nr of time periods and the actual end dates for them (but not the last one)
      textOutput("nr_of_periods"),
      textOutput("end_dates")
    )
  )
))

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


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

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

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

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

shinyApp(ui = ui, server = server)

使R闪亮的应用程序显示一连串日期的多次切割

0 个答案: