R Shiny: условное обновление возможных вариантов пользовательского ввода в динамической ситуации - PullRequest
Новая
       19

R Shiny: условное обновление возможных вариантов пользовательского ввода в динамической ситуации

0 голосов
/ 01 апреля 2019

Я создал крошечное приложение Shiny, в котором пользователя спрашивают, на сколько периодов он / она хочет вырезать данный вектор дат (между 2 и 4).Затем, для каждого периода времени, который пользователь хочет иметь (кроме последнего), ему / ей предлагается выбрать последнюю дату этого периода времени.

Приложение работает, однако, я боюсь, что некоторыеглупый пользователь может выбрать конечные даты, которые не являются инкрементными, например, выбранная конечная дата для периода времени 1 может быть позже, чем конечная дата, выбранная для периода времени 2, и т. д.

Другими словами, я 'я бы хотел, чтобы выбор (даты) был доступен пользователю при определении точки среза2 так, чтобы она содержала только даты, следующие после даты точки среза1, и т. д. Итак, если пользователь выбрал «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)

1 Ответ

1 голос
/ 01 апреля 2019

Вставьте это в функцию вашего сервера: 

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

В связи с тем, что вы делаете новый выбор selectInput всякий раз, когда вы увеличиваете количество периодов, вы (непреднамеренно) перезаписываете предыдущие результаты и сбрасываете начальный период,всякий раз, когда пользователь переходит, например, от 3 до 4 периодов отсечения.

...