闪亮：updateSelectInput 不会针对不同的 selectInput 条件进行更新

Question

根据第一个 selectInput 函数中选择的绘图类型，我在更新边栏中（可选）数据框的列名时遇到问题。 colnames 仅更新一次，这意味着 x 变量仅对第一个绘图类型可见，而 y 或区分变量仅适用于第二个绘图类型。第三种绘图类型不提供任何选择。

PS：从今天开始，我是 stackoverflow 的新手——我希望下面的示例能够提供足够的信息。提前致谢！

ui <- fluidPage(
sidebarLayout(
sidebarPanel(
  selectInput(inputId = "plottype",
              label = "Choose your favorite plot type",
              choices = c("Histogram" = 1,
                          "Scatterplot" = 2,
                          "Whatever" = 3)),
  conditionalPanel(
    condition = "input.plottype == 1",
    selectInput(inputId = "x_var",
                label = "X-variable",
                choices = ""),
    uiOutput("choose_columns_1")),

  conditionalPanel(
    condition = "input.plottype == 2",
    selectInput(inputId = "x_var",
                label = "X-variable",
                choices = ""),
    selectInput(inputId = "y_var",
                label = "Y-variable",
                choices = ""),
    selectInput(inputId = "fill",
                label = "Distinguish",
                choices = ""),
    uiOutput("choose_columns_2")),

  conditionalPanel(
    condition = "input.plottype == 3",
    selectInput(inputId = "x_var",
                label = "X-variable",
                choices = ""),
    selectInput(inputId = "y_var",
                label = "Y-variable",
                choices = ""),
    selectInput(inputId = "fill",
                label = "Distinguish",
                choices = ""),
    uiOutput("choose_columns_3"))),

  mainPanel()
  )
 )

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

getData <- reactive({
if(is.null(input$file1)) return(mtcars)
req(input$file1)
req(input$sep)
req(input$quote)
read.csv(input$file1$datapath,
         header = TRUE,
         sep = input$sep,
         quote = input$quote)
})

observe({
dsnames <- names(getData())
cb_options <- list()
cb_options[dsnames] <- dsnames
updateSelectInput(session, "x_var",
                  label = "X-variable",
                  choices = cb_options,
                  selected = "")
updateSelectInput(session, "y_var",
                  label = "Y-variable",
                  choices = cb_options,
                  selected = "")
updateSelectInput(session, "fill",
                  label = "Distinguish",
                  choices = cb_options,
                  selected = "")
})



output$choose_columns_1 <- renderUI({
if(is.null(input$dataset))
  return()
colnames <- cb_options
updateSelectInput(session, "x_var",
                  label = "X-variable",
                  choices = colnames,
                  selected = "")
})


output$choose_columns_2 <- renderUI({
if(is.null(input$dataset))
  return()
colnames2 <- cb_options
updateSelectInput(session, "x_var",
                  label = "X-variable",
                  choices = colnames2,
                  selected = "")
updateSelectInput(session, "y_var",
                  label = "Y-variable",
                  choices = colnames2,
                  selected = "")
updateSelectInput(session, "fill",
                  label = "Distinguish",
                  choices = colnames2,
                  selected = "")
})

output$choose_columns_3 <- renderUI({
if(is.null(input$dataset))
  return()
colnames3 <- cb_options
updateSelectInput(session, "x_var",
                  label = "X-variable",
                  choices = colnames3,
                  selected = "")
updateSelectInput(session, "y_var",
                  label = "Y-variable",
                  choices = colnames3,
                  selected = "")
updateSelectInput(session, "fill",
                  label = "Distinguish",
                  choices = colnames3,
                  selected = "")
})

}

shinyApp(ui, server)

Answer 1

您可以尝试（使用三个数据集来模拟您的需求）：

data_sets <- c("mtcars", "morley", "rock")

ui = fluidPage(
   sidebarLayout(
     sidebarPanel(
       uiOutput("choose_dataset"),
       selectInput(inputId = "plottype",
                   label = "Choose your favorite plot type",
                   choices = c("Histogram" = 1,
                               "Scatterplot" = 2,
                               "Whatever" = 3)),
       conditionalPanel(
         condition = "input.plottype == 1", uiOutput("x_var")),
       conditionalPanel(
         condition = "input.plottype == 2 || input.plottype == 3",
       uiOutput("y_var"), uiOutput("fill"))

     ),
     mainPanel()
   )
 )

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

   output$choose_dataset <- renderUI({
     selectInput("dataset", "Data set", as.list(data_sets))
   })


   output$x_var <- renderUI({
     # If missing input, return to avoid error later in function
     if(is.null(input$dataset))
       return()

     # Get the data set with the appropriate name
     dat <- get(input$dataset)
     colnames <- names(dat)

     # Create the checkboxes and select them all by default
     selectInput(inputId = "x_var",
                 label = "X-variable", 
                        choices  = colnames,
                        selected = colnames)
   })


   output$y_var <- renderUI({
     # If missing input, return to avoid error later in function
     if(is.null(input$dataset))
       return()

     # Get the data set with the appropriate name
     dat <- get(input$dataset)
     colnames <- names(dat)

     # Create the checkboxes and select them all by default
     selectInput(inputId = "y_var",
                 label = "Y-variable", 
                 choices  = colnames,
                 selected = colnames)
   })

   output$fill <- renderUI({
     # If missing input, return to avoid error later in function
     if(is.null(input$dataset))
       return()

     # Get the data set with the appropriate name
     dat <- get(input$dataset)
     colnames <- names(dat)

     # Create the checkboxes and select them all by default
     selectInput(inputId = "fill",
                 label = "Distinguish", 
                 choices  = colnames,
                 selected = colnames)
   })

}

 shinyApp(ui = ui, server = server)