OceanSky_U
OceanSky_U

Reputation: 359

Shiny checkboxGroupInput does not allow more than one option to be selected

I am trying to create a reactive group checkbox based on the number of periods and phenotypes as user input and set a default selected option in the checkbox (with period >1) based on the user choices in period 1. For example, there are three options of method1, 2, and 3 in the checkbox and if the user selected "method1" in period 1, the later period (>1) will automatically have the "method1" selected within each phenotype. Otherwise, there is no interaction across the period if user selected other options in period 1.

In the demo code below, I was able to do this using an if-else in the server code. However, I can not select other options (i.e., methods 2 and 3) in Phenotype1: period1 checkbox like in Phenotype1: period2 checkbox (see attachment 1). My goal is to be able to select other options in Phenotype1: period1 checkbox and also automatically select "method1" in Phenotype1: period2 conditioned on method1 is selected in Phenotype1: period1 checkbox.

Modification: I added back another reactive variable nPheno (the real case I have) to properly illustrate the problem I have. In this case I can not hard code the Phenotypej: period1 checkbox as this is user specified.

Any help/suggestions are appreciated!

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)

enter image description here

Upvotes: 1

Views: 809

Answers (1)

YBS
YBS

Reputation: 21287

Split the renderUI into two parts. As you are using info from the first renderUI in the second one, it will be better this way. Try this

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)

output

Upvotes: 1

Related Questions