Я создал крошечное приложение Shiny, в котором пользователя спрашивают, на сколько периодов он хочет вырезать данный вектор дат (от 2 до 4). Затем для каждого временного периода, который пользователь хочет иметь (кроме последнего), ему / ей предлагается выбрать последнюю дату этого временного периода.
Приложение работает, однако я боюсь, что какой-то глупый пользователь может выбрать даты окончания, которые не являются инкрементными, например, выбранная конечная дата для временного периода 1 может быть позже по времени, чем конечная дата, выбранная для временного периода 2, и т. Д.
Другими словами, я хотел бы сделать выбор (даты) доступным для пользователя при определении точки cutpoint2, чтобы она содержала только даты, которые приходят ПОСЛЕ даты cutpoint1 и т. Д. Итак, если пользователь выбрал «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)
