mercredi 28 juin 2023

Automatically check/uncheck one checkbox if another is checked/unchecked in R Shiny

I have a Shiny app in which users may choose a number of textInput boxes based on a numericInput, which also determines the number of checkbox pairs. When these checkboxes are marked, the text in the textInput is added to separate lists depending on which checkbox is marked. In this app, everything that exists in the normalized_controls_coll list must also exist in the controls_coll list, but not necessarily vice versa. I have made an attempt at making it so that the normCTLcheckbox will automatically be checked if CTLcheckbox is checked, and that normCTLcheckbox will be unchecked if CTLcheckbox is unchecked.

Below is my best attempt, although this dependency does not happen. Does anyone have any ideas for this? Thanks!

library(shiny)
library(shinyWidgets)
library(htmlwidgets)

########## User interface ##########
ui = fluidPage(
  
  navbarPage("",
             
             #### Tab Panel 3 ####
             tabPanel("",
                      fluidRow(
                        sidebarPanel(
                          ####Conditions information####
                          #Determine the number of conditions to be labelled
                          
                          
                          numericInput("num_conds", 
                                       label = "Conditions",
                                       min = 1,
                                       max = 96,
                                       value = 1),
                          
                          br(),
                          h5(helpText("Changing the number of experimental conditions will erase all designated colors and conditions.")),
                          
                          helpText("control checkbox"),
                          verbatimTextOutput("ctls_checked"),
                          helpText('normalizing control checkbox'),
                          verbatimTextOutput("norm_ctls_checked")
                        ),
                        
                        mainPanel(
                          tags$style('.shiny-options-group{ 
                                        margin-top: 5px !important;}'),
                          
                          column(4, "",
                                 uiOutput("boxes_conds")
                          ), #close condition columns
                          
                          column(4, "",
                                 
                                 uiOutput("control_checkbox"),
                          ),
                          
                          
                        ),
                      ), #close fluidrow
             ), #End panel 3
  ) #close navbarpage
)#close ui, fluidpage


########## Server logic #########

server = function(input, output, session) {

  #### Page 3: Conditions ####
  
  #Number output for number of conditions
  output$value <- renderPrint({ input$num_conds })
  
  #Experimental condition boxes for UI text input
  output$boxes_conds <- renderUI({
    num_conds <- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      cond_names <- textInput(paste0("condID", i),
                              label = paste0("Treatment/ Condition ", i),
                              placeholder = "Enter condition...")
    })
  })
  
  output$control_checkbox <- renderUI({
    num_conds <- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      div(
        checkboxInput(paste0("CTLcheckbox", i), 
                      label = paste0("Control ", i), 
                      value = FALSE),
        
        checkboxInput(paste0("normCTLcheckbox", i), 
                      label = paste0("Normalizing control ", i), 
                      value = FALSE),
        
        
        style = 'padding-bottom: 7.62px;'

      )
    })
  })
  
  #verification list for the controls, positive/mut or negative/WT
  controls_list <- list()
  
  controls <- reactive({ 
    num_conds <- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) { 
      if(input[[paste0('CTLcheckbox', i)]] ==  TRUE) 
        controls_list <- input[[paste0('condID', i)]]
    })
    
  })
  
  controls_coll <- reactive({ strsplit(paste0(unlist(controls(), recursive = FALSE), collapse = ','), ",") })
  
  output$ctls_checked <- renderPrint({ 
    controls_coll()
    
  })
  
  #verification list for the normalized controls list
  normalized_controls_list <- list()
  
  normalized_controls <- reactive({ 
    num_conds <- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      
      if(input[[paste0('normCTLcheckbox', i)]] ==  TRUE) 
        controls_list <- input[[paste0('condID', i)]]
    })
  })
  
  normalized_controls_coll <- reactive({ strsplit(paste0(unlist(normalized_controls(), recursive = FALSE), collapse = ','), ",") })
  
  
  output$norm_ctls_checked <- renderPrint({ 
    normalized_controls_coll()
    
  })

  #This is my current attempt at making it so that the normalized_control checkboxes are dependant on the control checkboxes
  observeEvent(input$num_conds, {
    lapply(1:input$num_conds, function(i){
      
      
      observeEvent(input[[paste0('CTLcheckbox', i)]], {
        #This will set the normalized_control checkboxes to FALSE whenever the control checkbox is FALSE
        if (input[[paste0('CTLcheckbox', i)]] == FALSE && input[[paste0('normCTLcheckbox', i)]] == TRUE)
          updateCheckboxInput(session, input[[paste0('normCTLcheckbox', i)]], value = input[[paste0('CTLcheckbox', i)]]) 
      })
      
      observeEvent(input[[paste0('normCTLcheckbox', i)]], {
        #This will update the control checkboxes to TRUE whenever the normalized_control checkbox is TRUE
        if (input[[paste0('CTLcheckbox', i)]] == FALSE && input[[paste0('normCTLcheckbox', i)]] == TRUE)
          updateCheckboxInput(session, input[[paste0('CTLcheckbox', i)]], value = input[[paste0('normCTLcheckbox', i)]]) 
      })
    })
  })
  
  
} # close server

shinyApp(ui = ui, server = server)



Aucun commentaire:

Enregistrer un commentaire