在R Shiny中如何实现取消勾选checkboxInput时触发对应操作

核心修改点 #

• 移除复选框矩阵中Hide列的生成逻辑，仅保留Show、Reset两列
• 替换原独立的显示/隐藏监听逻辑，改为直接绑定Show复选框的勾选状态控制第二输入矩阵的显隐，复选框默认未勾选，刚好满足启动默认隐藏的要求
• 新增CSS规则调整表格列宽，第一列加宽，后两列宽度固定保持一致

完整可运行代码 #

library(shiny)
library(shinyjs)
library(shinyMatrix) # 补充原代码漏写的依赖包

### Begin checkbox matrix ###
f <- function(action,i){as.character(checkboxInput(paste0(action,i),label=NULL))}
actions       <- c("show", "reset") # 移除hide选项
tbl           <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Show", "Reset") # 移除Hide列名
rownames(tbl) <- c("2nd input", "3rd input")
### End checkbox matrix ###

firstInput <- function(inputId){
  matrixInput(inputId, 
              value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

secondInput <- function(inputId,x){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      "td .checkbox {margin-top: 0; margin-bottom: 0;}
       td .form-group {margin-bottom: 0;}
       /* 新增列宽控制规则 */
       table thead tr th:first-child {width: 120px; text-align: left;}
       table thead tr th:not(:first-child) {width: 60px;}"
    ))
  ),
  br(),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      hidden(uiOutput("secondInput")),
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output, session){ # 补充session参数可用于后续reset功能开发
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  
  output$panel <- renderUI({
    tagList(
      useShinyjs(),
      firstInput("input1"),
      strong(helpText("Generate curves (Y|X):")),
      tableOutput("checkboxes") 
    )
  })
  
  ### Begin checkbox matrix ###
  output[["checkboxes"]] <- 
    renderTable({tbl}, 
                rownames = TRUE, align = "c",
                sanitize.text.function = function(x) x
    )
  # 替换原show/hide监听逻辑，单复选框控制显隐
  observe({
    if(isTRUE(input$show1)){
      shinyjs::show("secondInput")
    }else{
      shinyjs::hide("secondInput")
    }
  })
  ### End checkbox matrix ###
  
  output$secondInput <- renderUI({
    req(input1())
    secondInput("input2",input$input1[1,1])
  })
  
  outputOptions(output,"secondInput",suspendWhenHidden = FALSE) 
  
  output$plot1 <-renderPlot({
    req(input2())
    plot(rep(input2(),times=5))
  })
  
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Curious Jorge - user9788072