闪亮的条件面板无法在多个条件下使用 uiOutput

Question

我正在尝试使用闪亮的 SelectInput 制作反应式 UI。我有一个带有 renderUI selectizeInput (server.R) 的服务器，如果我尝试从 conditionalPanels 调用 uiOutput 中做出两个选择，服务器会冻结 (ui.R)：

服务器.R

output$selz_01 <- renderUI({
  withProgress(message = 'Data is loading, please wait ...', value = 1:100, {
          selectizeInput(inputId="valuez01",
                   label="Select value 1:",
                   choices= unique(tab_01()$key),
                   selected =head(unique(tab_01()$key)),  
                   multiple = TRUE) 
}) })

output$selz_02 <- renderUI({
  withProgress(message = 'Data is loading, please wait ...', value = 1:100, {
          selectizeInput(inputId="valuez02",
                   label="Select value 2:",
                   choices= unique(tab_01()$measurements),
                   selected =head(unique(tab_01()$measurements)),  
                   multiple = TRUE) 
}) })

output$selz_03 <- renderUI({
  withProgress(message = 'Data is loading, please wait ...', value = 1:100, {
          selectizeInput(inputId="valuez03",
                   label="Select value 3:",
                   choices= unique(tab_01()$date),
                   selected =head(unique(tab_01()$date)),  
                   multiple = TRUE) 
}) })

ui.R

 radioGroupButtons(
                   inputId = "selChoices",
                   choiceNames =
                     list(icon("dice-one"), icon("dice-two"),
                          icon("dice-three")),
                   choiceValues =
                     list("one", "two", "three"),
                   label = "Choices", 
                   status = "default"
                 ),

conditionalPanel(
                  condition = "input.selChoices == 'one'",
                  uiOutput("selz_01"),
                  uiOutput("selz_02")
                 ),
conditionalPanel(
                  condition = "input.selChoices == 'two'",
                  uiOutput("selz_01"),
                  uiOutput("selz_03")
                 ),
conditionalPanel(
                  condition = "input.selChoices == 'three'",
                  uiOutput("selz_02"),
                  uiOutput("selz_03")
                 ),

Answer 1

最好在 ui 中只使用一次输出 ID，如 cmets 中所述。您可以在renderUI 中给出条件输出。一种方法如下所示。

ui <- fluidPage(
  radioGroupButtons(
    inputId = "selChoices",
    choiceNames =
      list(icon("dice-one"), icon("dice-two"),
           icon("dice-three")),
    choiceValues =
      list("one", "two", "three"),
    label = "Choices", 
    status = "default"
  ),
  uiOutput("selz_01"),
  uiOutput("selz_02"),
  uiOutput("selz_03")

)

server <- function(input, output, session) {
  
  tab_01 <- reactive({
    df <- gapminder[gapminder$continent=="Americas",]
    df$key <- df$country
    df$measurements <- df$lifeExp
    df$date <- df$year
    df
  })
  
  output$selz_01 <- renderUI({
    if (input$selChoices %in% c("one","two")) {
      withProgress(message = 'Data is loading, please wait ...', value = 1:100, {
        selectizeInput(inputId="valuez01",
                       label="Select value 1:",
                       choices= unique(tab_01()$key),
                       selected =head(unique(tab_01()$key)),  
                       multiple = TRUE) 
      }) 
    }else return(NULL)
    
  })
  
  output$selz_02 <- renderUI({
    if (input$selChoices %in% c("one","three")) {
      withProgress(message = 'Data is loading, please wait ...', value = 1:100, {
        selectizeInput(inputId="valuez02",
                       label="Select value 2:",
                       choices= unique(tab_01()$measurements),
                       selected =head(unique(tab_01()$measurements)),  
                       multiple = TRUE) 
      })
    }else return(NULL)
     
  })
  
  output$selz_03 <- renderUI({
    if (input$selChoices %in% c("three","two")) {
      withProgress(message = 'Data is loading, please wait ...', value = 1:100, {
        selectizeInput(inputId="valuez03",
                       label="Select value 3:",
                       choices= unique(tab_01()$date),
                       selected =head(unique(tab_01()$date)),  
                       multiple = TRUE) 
      }) 
    }else return(NULL)
  })
  
}

shinyApp(ui, server)