闪亮的 checkboxGroupInput 不允许选择多个选项

Question

我正在尝试根据用户输入的 句点 和 表型 的数量创建一个反应组复选框，并在复选框中设置一个默认选定选项（带有句点 > 1）根据用户在周期1中的选择。例如，复选框中有method1、2、3三个选项，如果用户在周期1中选择了“method1”，则后期（>1）将自动在每个表型中选择“方法1”。否则，如果用户在周期 1 中选择了其他选项，则在整个周期内没有交互。

在下面的演示代码中，我可以在服务器代码中使用 if-else 来做到这一点。但是，我无法在 Phenotype1: period1 checkbox 中选择其他选项（即方法 2 和 3），例如 Phenotype1: period2 checkbox（参见附件 1强>）。我的目标是能够在 Phenotype1: period1 复选框 中选择其他选项，并根据 method1 在 Phenotype1: period2 中自动选择“method1”在Phenotype1: period1 checkbox中被选中。

修改： 我添加了另一个反应变量nPheno（我的真实情况）以正确说明我遇到的问题。在这种情况下，我不能硬编码 Phenotypej: period1 复选框，因为这是用户指定的。

感谢任何帮助/建议！

library(shiny)
ui <- basicPage(
  numericInput("nPheno", "Number of phenotypes", value = 1,
               min = 1),
  numericInput("nPeriod", "Number of periods", value = 1,
                               min = 1),
  uiOutput("idx1")
)

server <- shinyServer(function(input, output, session){
  output$idx1 <- renderUI({
    Nperiod <- as.integer(input$nPeriod)
    Npheno <- as.integer(input$nPheno)
    lapply(1:Npheno, function(j){
      lapply(1:Nperiod, function(i){
             # Here I used if else to set checkbox when Nperiod = 1 (selected = NULL)
             # and > 1 (selected = based on selection in Npreiod = 1)
               if (Nperiod == 1){
                 list(fluidRow(column(6, wellPanel(
                                        checkboxGroupInput(paste0("phenotype", j, "period", i),
                                                           label = paste0("Phenotype", j, ": period", i),
                                                           choices = c("method1", "method2", "method3"),
                                                           # when period = 1, the defaulted selected is set as NULL
                                                           selected = NULL)))))
               } else {
                 list(fluidRow(column(6, wellPanel(
                                        checkboxGroupInput(paste0("phenotype", j, "period", i),
                                                           label = paste0("Phenotype", j, ": period: ", i),
                                                           choices = c("method1", "method2", "method3"),
                                                           # when period > 1, the defaulted selected is
                                                           # set as "method1" if user selected "method1" in preiod 1 otherwise NULL
                                                           selected = switch("method1" %in% input[[paste0("phenotype", j, "period", 1)]],
                                                                             "method1", NULL))
                                      )))) }
             })
    })
  })
})

shinyApp(ui, server)

Answer 1

将renderUI 拆分为两部分。当您在第二个中使用来自第一个 renderUI 的信息时，这样会更好。试试这个

library(shiny)
ui <- basicPage(
  numericInput("nPheno", "Number of phenotypes", value = 1, min = 1),
  numericInput("nPeriod", "Number of periods", value = 1, min = 1),
  uiOutput("idx"),
  uiOutput("idx1")
)

server <- shinyServer(function(input, output, session){
  mychoices <- list("method1", "method2", "method3")
  
  output$idx <- renderUI({
    Npheno <- as.integer(input$nPheno)
    
    lapply(1:Npheno, function(j){
      list(fluidRow(column(6, wellPanel(
        checkboxGroupInput(paste0("phenotype", j, "period", 1),
                           label = paste0("Phenotype", j, ": period", 1),
                           choices = mychoices,
                           # when period = 1, the defaulted selected is set as NULL
                           selected = NULL
        )))))
    })
  })
  
  output$idx1 <- renderUI({
    Nperiod <- as.integer(input$nPeriod)
    Npheno <- as.integer(input$nPheno)
    if (Nperiod > 1){
      lapply(2:Nperiod, function(i){
        lapply(1:Npheno, function(j){

          list(fluidRow(column(6, wellPanel(
            checkboxGroupInput(paste0("phenotype", j, "period", i),
                               label = paste0("Phenotype", j, ": period: ", i),
                               choices = mychoices,
                               # when period > 1, the defaulted selected is set as "method1" 
                               # if user selected "method1" in period 1 otherwise NULL
                               selected = switch("method1" %in% as.character(input[[paste0("phenotype", j, "period", 1)]]),
                                                 "method1", NULL))
          )))) 
        })
      })
    }
  })
})

shinyApp(ui, server)