如何使 selectizeInput 函数对多个用户输入做出反应？

Question

这个 post 是昨天 post、.

的后续

下图顶部显示并通过此 post 底部的 MWE 生成的数据框有两种类型的周期测量：Period_1 和 Period_2。 Period_1 表示元素出现后经过的月数，Period_2 是 YYYY-MM 形式的日历月表示。我通过 server 部分中的简单占位符函数插入了 radioButton() 让用户选择运行的句点类型（“periodType”），但我不确定一种有效的方法，尤其是在 ui 部分中的 selectizeInput() 函数中，无需求助于 renderUI()。有关如何执行此操作的任何建议？

这张图片更好地解释了：

MWE 代码：

library(shiny)
library(data.table)

DT <- data.table(
  ID = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
  Period_1 = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
  Period_2 = c("2020-01","2020-02","2020-03","2020-02","2020-03","2020-04","2020-03","2020-04","2020-05"),
  Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9)
)

all_choices <- function(x) {unique(x)}

ui <- fluidPage(
  tableOutput("data"),
  
  radioButtons("periodType",
               label = "Period type selection:",
               choiceNames = c('Period_1','Period_2'),
               choiceValues = c('Period_1','Period_2'),
               selected = 'Period_1',
               inline = TRUE
  ),
  
  selectizeInput(
    inputId = "fromPeriod",
    label = "From period:",
    choices = setdiff(all_choices(DT$Period_1), last(all_choices(DT$Period_1))),
    selected = 1
  ),
  selectizeInput(
    inputId = "toPeriod",
    label = "To period:",
    choices = setdiff(all_choices(DT$Period_1), first(all_choices(DT$Period_1))),
    selected = 2
  ),
  tableOutput("dataSelect")
)

server <- function(input, output, session) {
  
  output$data <- renderTable({DT})
  
  observeEvent(input$fromPeriod, {
    freezeReactiveValue(input, "toPeriod")
    updateSelectizeInput(
      session,
      inputId = "toPeriod",
      choices = all_choices(DT$Period_1)[all_choices(DT$Period_1) > input$fromPeriod],
      selected = max(all_choices(DT$Period_1)[all_choices(DT$Period_1) > input$fromPeriod])
    )
  }, ignoreInit = TRUE)
  
  output$dataSelect <- renderTable({
    setorder(DT[Period_1 %in% c(input$fromPeriod, input$toPeriod)], Period_1)
  }, rownames = TRUE)
}

shinyApp(ui, server)

Answer 1

我们可以根据选择更新选项：

library(shiny)
library(data.table)

DT <- data.table(
  ID = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
  Period_1 = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
  Period_2 = c("2020-01","2020-02","2020-03","2020-02","2020-03","2020-04","2020-03","2020-04","2020-05"),
  Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9)
)

all_choices_p1 <- unique(DT$Period_1)
all_choices_p2 <- unique(DT$Period_2)

ui <- fluidPage(
  tableOutput("data"),
  radioButtons("periodType",
               label = "Period type selection:",
               choiceNames = c('Period_1','Period_2'),
               choiceValues = c('Period_1','Period_2'),
               selected = 'Period_1',
               inline = TRUE
  ),
  selectizeInput(
    inputId = "fromPeriod",
    label = "From period:",
    choices = all_choices_p1[-length(all_choices_p1)],
    selected = 1
  ),
  selectizeInput(
    inputId = "toPeriod",
    label = "To period:",
    choices = all_choices_p1[-1],
    selected = 2
  ),
  tableOutput("dataSelect")
)

server <- function(input, output, session) {
  
  all_choices_reactive <- reactiveVal(all_choices_p1)
  output$data <- renderTable({DT})
  
  observeEvent(input$periodType, {
    if(input$periodType == "Period_1"){
      all_choices_reactive(all_choices_p1)
    } else {
      all_choices_reactive(all_choices_p2)
    }
    updateSelectizeInput(
      session,
      inputId = "fromPeriod",
      choices = all_choices_reactive()[-length(all_choices_reactive())]
    )
    updateSelectizeInput(
      session,
      inputId = "toPeriod",
      choices = all_choices_reactive()[-1]
    )
  })
  
  observeEvent(input$fromPeriod, {
    freezeReactiveValue(input, "toPeriod")
    updateSelectizeInput(
      session,
      inputId = "toPeriod",
      choices = all_choices_reactive()[all_choices_reactive() > input$fromPeriod],
      selected = max(all_choices_reactive()[all_choices_reactive() > input$fromPeriod])
    )
  }, ignoreInit = TRUE)
  
  output$dataSelect <- renderTable({
    if(input$periodType == "Period_1"){
      keep_cols <- c("ID", "Period_1", "Values")
      setorder(DT[Period_1 %in% c(input$fromPeriod, input$toPeriod), ..keep_cols], Period_1)
    } else {
      keep_cols <- c("ID", "Period_2", "Values")
      setorder(DT[Period_2 %in% c(input$fromPeriod, input$toPeriod), ..keep_cols], Period_2)
    }
  }, rownames = TRUE)
}

shinyApp(ui, server)

如何使 selectizeInput 函数对多个用户输入做出反应？

How to make selectizeInput function reactive to multiple user inputs?

r

shiny

shiny-reactivity

renderui