如何在R Shiny中以网格模式整齐排列用户复选框及其他输入控件

在如下MWE代码中，我希望找到一种整洁有序的方式排布用户复选框输入。我目前使用的fluidRows和columns难以调整出清爽的展示效果。该MWE对应的完整应用共有12个用户复选框，因此我需要找到简洁的方案将它们紧凑排布。从下方图片及代码运行效果可见，当前按钮无法在各行正确对齐，行高过高，还需添加网格线辅助展示等。

为便于演示，下方代码仅使用“Show”和“Hide”两类复选框。

MWE代码 #

rm(list = ls())

library(shiny)
library(shinyMatrix)
library(shinyjs)

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(
  titlePanel("Model"),
    sidebarLayout(
      sidebarPanel(
        uiOutput("panel"),
        hidden(uiOutput("secondInput"))),
      mainPanel(plotOutput("plot1"))
    )
  )

server <- function(input, output, session) {
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  
  output$panel <- renderUI({
    tagList(
      useShinyjs(),
      firstInput("input1"),
      strong(helpText("Generate curves (Y|X):")),
      
      div(style = "font-size: 14px; padding: 0px; margin-top:0em",
        fluidRow(
          fluidRow(
            column(5,),
            column(2,helpText("Show"),align="center"),
            column(2,helpText("Hide"),align="center"),
            column(2,helpText("Reset"),align="center")
          ),
          div(style = "font-size: 14px; padding: 0px; margin-top:0em",  
            fluidRow(
              column(5, helpText("1st input"),offset = 1),
              column(2, checkboxInput('show', NULL, value = FALSE, width = NULL)),
              column(2, checkboxInput('hide', NULL, value = FALSE, width = NULL)),
              column(2,)
            )
          ),
          div(style = "font-size: 14px; padding: 0px; margin-top:0em",  
            fluidRow(
              column(5,helpText("2nd input"),offset = 1),
              column(2,),
              column(2,),
              column(2,)
            )
          )
        )
      )
    )
  })
  
  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))
  })
  
  observeEvent(input$show,{
    shinyjs::show("secondInput")
    updateCheckboxInput(session, "hide", value = FALSE)
    })
  
  observeEvent(input$hide,{
    shinyjs::hide("secondInput")
    updateCheckboxInput(session, "show", value = FALSE)
    })
}

shinyApp(ui, server)

当前效果截图 #

直接改用HTML表格实现复选框的规整排布，可完美解决对齐、行高、网格线问题，后续新增12个复选框也只需按行追加表格元素即可，维护成本极低。
你只需要替换原代码中output$panel内的复选框排布部分即可，修改后的完整output$panel代码如下：

output$panel <- renderUI({
    tagList(
      useShinyjs(),
      firstInput("input1"),
      strong(helpText("Generate curves (Y|X):")),
      # 自定义表格样式：紧凑、居中对齐、带边框网格
      tags$style(HTML("
        .checkbox-table {
          width: 100%;
          border-collapse: collapse;
          font-size: 14px;
          margin-top: 10px;
        }
        .checkbox-table th, .checkbox-table td {
          padding: 4px 8px;
          text-align: center;
          border: 1px solid #ddd;
        }
        .checkbox-table .row-label {
          text-align: left;
          width: 50%;
        }
        .checkbox-table input[type='checkbox'] {
          margin: 0;
        }
      ")),
      tags$table(class = "checkbox-table",
        tags$thead(
          tags$tr(
            tags$th(class = "row-label", ""),
            tags$th("Show"),
            tags$th("Hide"),
            tags$th("Reset")
          )
        ),
        tags$tbody(
          tags$tr(
            tags$td(class = "row-label", "1st input"),
            tags$td(checkboxInput('show', NULL, value = FALSE, width = "100%")),
            tags$td(checkboxInput('hide', NULL, value = FALSE, width = "100%")),
            tags$td("")
          ),
          tags$tr(
            tags$td(class = "row-label", "2nd input"),
            tags$td(""),
            tags$td(""),
            tags$td("")
          )
          # 后续新增其他配置行直接在这里追加<tr>元素即可
        )
      )
    )
  })

方案优势 #

• 所有复选框和表头自动居中对齐，不会出现错位问题
• 行高通过padding参数可自由调整，默认设置非常紧凑
• 自带网格边框，可读性更强
• 后续新增复选框只需新增<tr>行元素即可，无需计算column宽度，适配12个复选框的需求非常方便

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