How to make selectizeInput function reactive to multiple user inputs?-CodePudding

This post is a follow-on to yesterday's post,

MWE code:

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)

CodePudding user response：

We can update the choices based on the selection:

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)