返回与当前日期匹配的 SelectInput 的默认值

Question

我希望根据评估 sys.Date() 与具有日期范围的数据框来解决在下拉 (SelectInput) 列表中显示默认值的问题。

df1:

code   date        group
10001  2015-10-07  a
10005  2015-10-11  b
10022  2015-10-18  c
10032  2015-10-23  d
10044  2015-10-30  a

创建第二个 df 来评估今天的日期（恰好是 2015-10-18）

active.date=as.data.frame((Sys.Date()))
names(active.date)[1]<-"date"
active.date$date=as.Date(active.date$date)

我确信可能有一种更清洁的方法，但它确实有效......

我知道：

match(active.date$date,df1$date)

将返回匹配的正确行，这可能是我需要前往的地方...

在 UI 方面，我有：

 selectInput("get.id",label="ID NUMBER", setNames(as.list(df1$code),df1$date)),

 actionButton("submit", "SUBMIT")

下拉列表中显示的第一个值只是数据框中的第一项：

2015-10-07

我想要实现的是从下拉列表中返回默认值作为活动日期（对于今天的示例）匹配时：

2015-10-18

并在没有匹配项时返回列表中的第一项。我仍然想在下拉列表中返回所有可能的值（以便可以选择所有日期），理想情况下，它将保持正确的日期顺序，以便它们出现。

Answer 1

我会在加载应用程序时订购数据。并相应地呈现选择输入。

library(shiny)
shinyApp(
    shinyUI(
        fluidPage(
            uiOutput('getter'),
            actionButton('submit', 'SUBMIT')
        )
    ),
    shinyServer(function(input, output, session) {
        today <- Sys.Date()
        dat <- reactive({
            ind <- match(today, as.Date(df1$date), FALSE)
            if (ind) df1[c(ind, seq_len(nrow(df1))[-ind]), ]
            else df1
        })

        output$getter <- renderUI({
            selectInput('get.id', label="ID NUMBER", choices=as.character(dat()$date))
        })
    })
)

或者，您可以将选择保留为响应式并使用

choices <- reactive({
    ind <- match(today, as.Date(df1$date), FALSE)
    if (ind) df1$date[c(ind, seq_len(nrow(df1))[-ind])]
    else df1$date
})

output$getter <- renderUI({
    selectInput('get.id', label="ID NUMBER", choices=as.character(choices()))
})