两个 Reactive Picker 输入,保留选择先前的事件 Shiny R

Two Reactive Picker Input, Retain Selection Previous Event Shiny R

我正在构建一个闪亮的应用程序。在 UI 我有一个 selectInput 和一个 pickerInput。当然 pickerInput 取决于 selectInput。在下面的示例中,我想找到一种方法如何在用户更改 selectInput.

时保留在 pickerInput 中选择的内容

在下面的示例中,假设用户选择 Period 1: X to ZUKUSA 或同时选择 UKUSA。我想要的是,如果该用户将 Period 1: X to Z 更改为 Period 2: X to Y,则 UK 会自动被选中——或保持选中状态——(因为 UKPeriod 2: X to Y).

那么,如何在 input_period 更改时保留在 pickerInput 中选择的内容。

谢谢!

choice_name <- c('UK','USA','UK','USA','BE','BE')
choice_id <- c(1, 2, 1, 2, 3, 3)
period <- c('period1', 'period1', 'period2', 'period3', 'period3', 'period3')
data <- data.frame(choice_name, choice_id, period)

choices_picker <- unique(data$choice_id)
names(choices_picker) <- unique(data$choice_name)


ui <- bootstrapPage(                
  absolutePanel(left = 10, bottom = 10, draggable = TRUE, 
                selectInput(inputId = "input_period", label = "Period",
                            choices = c("Period 1: X to Z" = "period1", "Period 2: X to Y" = "period2", "Period 3: X to X" = "period3"),
                            selected = "period1"),
                pickerInput(inputId = "picker_cty",
                            label = "Select Country",
                            choices = choices_picker,
                            multiple = TRUE),
  ))

server <- function(input, output, session) {
  
  # Reactive pickerInput ---------------------------------
  observeEvent(input$input_period, {
    
    data1 <- data[data$period == input$input_period,]
    datau <- unique(data$choice_id)
    data1u <- unique(data1$choice_id)
    
    disabled_choices <- ifelse(datau %in% data1u, 0,1)
    
    # Generate reactive picker input
    updatePickerInput(session = session, 
                      inputId = "picker_cty",
                      choices = choices_picker,
                      choicesOpt = list(
                        disabled = disabled_choices,
                        style = ifelse(disabled_choices,
                                       yes = "color: rgba(119, 119, 119, 0.5);",
                                       no = "")
                      ))
  }, ignoreNULL=FALSE)
  
}

shinyApp(ui, server)

您可以使用 select = 选项。试试这个

choice_name <- c('UK','USA','UK','USA','BE','BE')
choice_id <- c(1, 2, 1, 2, 3, 3)
period <- c('period1', 'period1', 'period2', 'period3', 'period3', 'period3')
data <- data.frame(choice_name, choice_id, period)
data2 <- data[data$period == "period1",]
choices_picker <- unique(data$choice_id)
names(choices_picker) <- unique(data$choice_name)

datau <- unique(data$choice_id)
data2u <- unique(data2$choice_id)

disabled_choicez <- ifelse(datau %in% data2u, 0,1)

ui <- bootstrapPage(
  absolutePanel(left = 10, bottom = 10, draggable = TRUE,
                selectInput(inputId = "input_period", label = "Period",
                            choices = c("Period 1: X to Z" = "period1", "Period 2: X to Y" = "period2", "Period 3: X to X" = "period3"),
                            selected = "period1" ),
                pickerInput(inputId = "picker_cty",
                            label = "Select Country",
                            choices = choices_picker,
                            choicesOpt = list(
                              disabled = disabled_choicez,
                              style = ifelse(disabled_choicez,
                                             yes = "color: rgba(119, 119, 119, 0.5);",
                                             no = "")
                            ),
                            selected = character(0),
                            multiple = TRUE),
  ))

server <- function(input, output, session) {

  observe({print(input$picker_cty)})

  # Reactive pickerInput ---------------------------------
  observeEvent(input$input_period, {

    data1 <- data[data$period == input$input_period,]
    datau <- unique(data$choice_id)
    data1u <- unique(data1$choice_id)

    disabled_choices <- ifelse(datau %in% data1u, 0,1)

    if (is.null(input$picker_cty)) selected = character(0)
    else {
      if (sum(data1u %in% input$picker_cty)>0) {
        selected = data1u[data1u %in% input$picker_cty]
      }else selected = character(0)
    }

    # Generate reactive picker input
    updatePickerInput(session = session,
                      inputId = "picker_cty",
                      choices = choices_picker,
                      selected = selected,
                      choicesOpt = list(
                        disabled = disabled_choices,
                        style = ifelse(disabled_choices,
                                       yes = "color: rgba(119, 119, 119, 0.5);",
                                       no = "")
                      ))
  }, ignoreInit = TRUE)

}

shinyApp(ui, server)