Question

在我的微型Shiny应用程序中，我问用户：您要将时间序列切成多少个时间段？例如，用户选择3。我想使用此输入获取固定的日期向量，并使用户可以从中选择所需的时间段1（在选择框1中）和时间段2（在选择框2中）。（时间段3的最后日期将是最后一个日期，所以我不需要问。）

我不确定该怎么做。我了解，因为我不知道所需的提前时间，所以我必须创建一个列表。但是我该如何从那些选择框中收集输入呢？

非常感谢！

library(shiny)

### UI #######################################################################

ui = shinyUI(fluidPage(

  titlePanel("Defining time periods"),

  # Sidebar: 
  sidebarLayout(
    sidebarPanel(
      # Slider input for the number of time periods:
      numericInput("num_periodsnr", label = "Desired number of time periods?",
                  min = 1, max = 10, value = 2),
      uiOutput("period_cutpoints")
    ),


    # Show just the number of periods so far.
    mainPanel(
      textOutput("nr_of_periods")
    )
  )
))



### SERVER ##################################################################

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

  library(lubridate)

  output$nr_of_periods <- renderPrint(input$num_periodsnr)

    # Define our dates vector:
  dates <- seq(ymd('2016-01-02'), ymd('2017-12-31'), by = '1 week')


  # STUCK HERE:
  # output$period_cutpoints<-renderUI({
  #   list.out <- list()
  #   for (i in 1:input$num_periodsnr) {
  #     list.out[[i]] <- renderPrint(paste0("Sometext", i), ,
  #                                  )
  #   }
  #   return(list.out)
  # })

})

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

这类似于我提出的问题，后来又得出了here的答案。最大的变化是（可以预测）在服务器中。

用户界面中无需更改，但是正如您将在下面看到的，我添加了另一个textOutput，以便您可以看到最终选择的日期，并且我还添加了{{1 }}，我将在后面解释。

服务器功能有几个附加功能，我将首先对其进行描述，然后最后进行汇总。没错，您需要在actionButton内创建一个输入对象列表，可以通过renderUI进行操作。在此步骤中，您要创建的lapply个切割点数量要少得多，因为您说不需要最后一个切割点，所以要减去一个切割点：

selectInput

接下来，您将需要使用首先创建的output$period_cutpoints<-renderUI({ req(input$num_periodsnr) lapply(1:(input$num_periodsnr-1), function(i) { selectInput(inputId=paste0("cutpoint",i), label=paste0("Select cutpoint for Time Period ", i, ":"), choices=dates) }) })对象来访问每个值中选择的值，以相同的方式进行操作，然后为其分配新值。在我这个问题的版本中，我不知道如何在不使用reactiveValues来触发列表的情况下更新列表。简单的actionButton或reactive()不能解决问题，但我真的不知道为什么。

observe()

完整的应用程序代码如下：

seldates <- reactiveValues(x=NULL)
  observeEvent(input$submit, {
    seldates$x <- list()
    lapply(1:(input$num_periodsnr-1), function(i) { 
      seldates$x[[i]] <- input[[paste0("cutpoint", i)]]
    })
  })

Answer 2

您可以在lapply内部动态创建框，并将其作为1个输出对象发送到ui

require("shiny")
require('shinyWidgets')

ui = shinyUI(fluidPage(

  titlePanel("Defining time periods"),

  # Sidebar: 
  sidebarLayout(
    sidebarPanel(
      # Slider input for the number of time periods:
      numericInput("num_periodsnr", label = "Desired number of time periods?",
                   min = 1, max = 10, value = 2),
      uiOutput("period_cutpoints")
    ),


    # Show just the number of periods so far.
    mainPanel(
      textOutput("nr_of_periods")
    )
  )
))


# Define server logic ----
server <- function(session, input, output) {

  output$period_cutpoints<- renderUI({
    req(input$num_periodsnr > 0)
    lapply(1:input$num_periodsnr, function(el) {
      airDatepickerInput(inputId = paste('PeriodEnd', el, sep = ''), label = paste('Period End', el, sep = ' '), clearButton = TRUE, range = F, update_on = 'close')
    })
})

}

# Run the app ----
shinyApp(ui = ui, server = server)

由于您没有提供数据集以应用输入，并且我不知道数据具有的日期范围，因此我没有添加代码来设置日期选择器的最小/最大，并且不确定哪种类型代码供您使用数据。您需要写一些东西来将它们确实放入列表中

values <- reactiveValues(datesplits = list(), 
previous_max = 0)

observeEvent(input$num_periodsnr, { 
  if(input$num_periodsnr > values$previous_max) {
    lapply(values$previous_max:input$num_periodsnr, function(el) { 
      observeEvent(input[[paste(paste('PeriodEnd', el, sep = '')]], {
        values$datesplits[el] <- input[[paste(paste('PeriodEnd', el, sep = '')]]
      })

    values$previous_max <- max(values$previous_max, input$num_periodsnr)
    })
  }
})

，然后使用日期列表来确定您需要使用的日期。

我使用从enter code here到previous_max input$num_periodsnr的运行圈if(input$num_periodsnr > values$previous_max){}的技巧来避免重复创建observers时产生的问题相同的input element。尽管ui元素在循环中创建时会被覆盖，但是observeEvents是作为副本创建的，因此，每次循环触发时，您都会复制observers 1:n的另一个副本。这将导致每次触发所有副本，直到您一百万次observers全部触发为止，从而造成可能的奇怪错误，不良影响和速度损失。

如何要求R Shiny根据先前的输入创建几个“选择框”

2 个答案: