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

huangapple go评论64阅读模式
英文:

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

问题

我尝试了以下代码,但这个依赖关系没有生效。有没有人对此有任何想法?谢谢!

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

########## 用户界面 ##########
ui = fluidPage(
  
  navbarPage("",
             
             #### 选项卡面板 3 ####
             tabPanel("",
                      fluidRow(
                        sidebarPanel(
                          #### 条件信息 ####
                          # 确定要标记的条件数量
                          
                          numericInput("num_conds", 
                                       label = "条件",
                                       min = 1,
                                       max = 96,
                                       value = 1),
                          
                          br(),
                          h5(helpText("更改实验条件的数量将删除所有指定的颜色和条件。")),
                          
                          helpText("控制复选框"),
                          verbatimTextOutput("ctls_checked"),
                          helpText('标准化控制复选框'),
                          verbatimTextOutput("norm_ctls_checked")
                        ),
                        
                        mainPanel(
                          tags$style('.shiny-options-group{ 
                                        margin-top: 5px !important;}'),
                          
                          column(4, "",
                                 uiOutput("boxes_conds")
                          ), #关闭条件列
                          
                          column(4, "",
                                 
                                 uiOutput("control_checkbox"),
                          ),
                          
                          
                        ),
                      ), #关闭fluidrow
             ), #结束面板 3
  ) #关闭navbarpage
)#关闭ui,fluidpage


########## 服务器逻辑 #########

server = function(input, output, session) {

  #### 页 3: 条件 ####
  
  # 用于条件数量的数字输出
  output$value <- renderPrint({ input$num_conds })
  
  # 用于UI文本输入的实验条件框
  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("处理/条件 ", i),
                              placeholder = "输入条件...")
    })
  })
  
  output$control_checkbox <- renderUI({
    num_conds <- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      div(
        checkboxInput(paste0("CTLcheckbox", i), 
                      label = paste0("控制 ", i), 
                      value = FALSE),
        
        checkboxInput(paste0("normCTLcheckbox", i), 
                      label = paste0("标准化控制 ", i), 
                      value = FALSE),
        
        
        style = 'padding-bottom: 7.62px;'

      )
    })
  })
  
  # 控制复选框的验证列表,正/突变或负/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()
    
  })
  
  # 标准化控制列表的验证列表
  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()
    
  })

  # 这是我目前尝试的方式,使标准化控制复选框依赖于控制复选框
  observeEvent(input$num_conds, {
    lapply(1:input$num_conds, function(i){
      
      
      observeEvent(input[[paste0('CTLcheckbox', i)]], {
        # 当控制复选框为FALSE时,将标准化控制复选框设置为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)]], {
        # 当标准化控制复选框为TRUE时,将控制复选框设置为TRUE
        if (input[[paste0('CTLcheckbox', i)]] == FALSE && input[[paste0('normCTLcheckbox', i)]] == TRUE)
          updateCheckboxInput(session, input[[paste0('CTLcheckbox', i)]], value = input[[paste0('normCTLcheckbox', i)]]) 
      })
    })
  })
  
  
} # 关闭服务器

shinyApp(ui = ui, server = server)
英文:

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(&quot;&quot;,
             
             #### Tab Panel 3 ####
             tabPanel(&quot;&quot;,
                      fluidRow(
                        sidebarPanel(
                          ####Conditions information####
                          #Determine the number of conditions to be labelled
                          
                          
                          numericInput(&quot;num_conds&quot;, 
                                       label = &quot;Conditions&quot;,
                                       min = 1,
                                       max = 96,
                                       value = 1),
                          
                          br(),
                          h5(helpText(&quot;Changing the number of experimental conditions will erase all designated colors and conditions.&quot;)),
                          
                          helpText(&quot;control checkbox&quot;),
                          verbatimTextOutput(&quot;ctls_checked&quot;),
                          helpText(&#39;normalizing control checkbox&#39;),
                          verbatimTextOutput(&quot;norm_ctls_checked&quot;)
                        ),
                        
                        mainPanel(
                          tags$style(&#39;.shiny-options-group{ 
                                        margin-top: 5px !important;}&#39;),
                          
                          column(4, &quot;&quot;,
                                 uiOutput(&quot;boxes_conds&quot;)
                          ), #close condition columns
                          
                          column(4, &quot;&quot;,
                                 
                                 uiOutput(&quot;control_checkbox&quot;),
                          ),
                          
                          
                        ),
                      ), #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 &lt;- renderPrint({ input$num_conds })
  
  #Experimental condition boxes for UI text input
  output$boxes_conds &lt;- renderUI({
    num_conds &lt;- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      cond_names &lt;- textInput(paste0(&quot;condID&quot;, i),
                              label = paste0(&quot;Treatment/ Condition &quot;, i),
                              placeholder = &quot;Enter condition...&quot;)
    })
  })
  
  output$control_checkbox &lt;- renderUI({
    num_conds &lt;- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      div(
        checkboxInput(paste0(&quot;CTLcheckbox&quot;, i), 
                      label = paste0(&quot;Control &quot;, i), 
                      value = FALSE),
        
        checkboxInput(paste0(&quot;normCTLcheckbox&quot;, i), 
                      label = paste0(&quot;Normalizing control &quot;, i), 
                      value = FALSE),
        
        
        style = &#39;padding-bottom: 7.62px;&#39;

      )
    })
  })
  
  #verification list for the controls, positive/mut or negative/WT
  controls_list &lt;- list()
  
  controls &lt;- reactive({ 
    num_conds &lt;- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) { 
      if(input[[paste0(&#39;CTLcheckbox&#39;, i)]] ==  TRUE) 
        controls_list &lt;- input[[paste0(&#39;condID&#39;, i)]]
    })
    
  })
  
  controls_coll &lt;- reactive({ strsplit(paste0(unlist(controls(), recursive = FALSE), collapse = &#39;,&#39;), &quot;,&quot;) })
  
  output$ctls_checked &lt;- renderPrint({ 
    controls_coll()
    
  })
  
  #verification list for the normalized controls list
  normalized_controls_list &lt;- list()
  
  normalized_controls &lt;- reactive({ 
    num_conds &lt;- as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      
      if(input[[paste0(&#39;normCTLcheckbox&#39;, i)]] ==  TRUE) 
        controls_list &lt;- input[[paste0(&#39;condID&#39;, i)]]
    })
  })
  
  normalized_controls_coll &lt;- reactive({ strsplit(paste0(unlist(normalized_controls(), recursive = FALSE), collapse = &#39;,&#39;), &quot;,&quot;) })
  
  
  output$norm_ctls_checked &lt;- 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(&#39;CTLcheckbox&#39;, i)]], {
        #This will set the normalized_control checkboxes to FALSE whenever the control checkbox is FALSE
        if (input[[paste0(&#39;CTLcheckbox&#39;, i)]] == FALSE &amp;&amp; input[[paste0(&#39;normCTLcheckbox&#39;, i)]] == TRUE)
          updateCheckboxInput(session, input[[paste0(&#39;normCTLcheckbox&#39;, i)]], value = input[[paste0(&#39;CTLcheckbox&#39;, i)]]) 
      })
      
      observeEvent(input[[paste0(&#39;normCTLcheckbox&#39;, i)]], {
        #This will update the control checkboxes to TRUE whenever the normalized_control checkbox is TRUE
        if (input[[paste0(&#39;CTLcheckbox&#39;, i)]] == FALSE &amp;&amp; input[[paste0(&#39;normCTLcheckbox&#39;, i)]] == TRUE)
          updateCheckboxInput(session, input[[paste0(&#39;CTLcheckbox&#39;, i)]], value = input[[paste0(&#39;normCTLcheckbox&#39;, i)]]) 
      })
    })
  })
  
  
} # close server

shinyApp(ui = ui, server = server)

答案1

得分: 1

代码中存在问题的地方是updateCheckboxInput;第二个参数应该是复选框的id,而不是复选框的

observeEvent(input$num_conds, {
  lapply(1:input$num_conds, function(i){
  
    observeEvent(input[[paste0('CTLcheckbox', i)]], {
      # 当控制复选框为FALSE时,将normalized_control复选框设置为FALSE
      if (input[[paste0('CTLcheckbox', i)]] == FALSE && input[[paste0('normCTLcheckbox', i)]] == TRUE)
        updateCheckboxInput(session, paste0('normCTLcheckbox', i), value = input[[paste0('CTLcheckbox', i)]]) 
    })
  
    observeEvent(input[[paste0('normCTLcheckbox', i)]], {
      # 当normalized_control复选框为TRUE时,将控制复选框设置为TRUE
      if (input[[paste0('CTLcheckbox', i)]] == FALSE && input[[paste0('normCTLcheckbox', i)]] == TRUE)
        updateCheckboxInput(session, paste0('CTLcheckbox', i), value = input[[paste0('normCTLcheckbox', i)]]) 
    })

  })
})
英文:

The problem with your code is the updateCheckboxInput; the second argument should be the checkbox id, not the checkbox value:

observeEvent(input$num_conds, {
lapply(1:input$num_conds, function(i){
observeEvent(input[[paste0(&#39;CTLcheckbox&#39;, i)]], {
#This will set the normalized_control checkboxes to FALSE whenever the control checkbox is FALSE
if (input[[paste0(&#39;CTLcheckbox&#39;, i)]] == FALSE &amp;&amp; input[[paste0(&#39;normCTLcheckbox&#39;, i)]] == TRUE)
updateCheckboxInput(session, paste0(&#39;normCTLcheckbox&#39;, i), value = input[[paste0(&#39;CTLcheckbox&#39;, i)]]) 
})
observeEvent(input[[paste0(&#39;normCTLcheckbox&#39;, i)]], {
#This will update the control checkboxes to TRUE whenever the normalized_control checkbox is TRUE
if (input[[paste0(&#39;CTLcheckbox&#39;, i)]] == FALSE &amp;&amp; input[[paste0(&#39;normCTLcheckbox&#39;, i)]] == TRUE)
updateCheckboxInput(session, paste0(&#39;CTLcheckbox&#39;, i), value = input[[paste0(&#39;normCTLcheckbox&#39;, i)]]) 
})
})
})

huangapple
  • 本文由 发表于 2023年6月29日 04:21:53
  • 转载请务必保留本文链接:https://go.coder-hub.com/76576496.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定