用于子选项的 R Shiny UI 复选框

为了为您的解决方案创建答案，我使用DT包实现了一个复选框组输入.解决方案分为两个部分:1.Helper函数.2.App.

Example Image

Helper Functions

第一个助手函数创建一个包含checkbox个输入的数据表，每个输入都有一个唯一的id，它是行名和列名的组合.

第二个帮助器函数判断构造的表中每个复选框的"选中"状态，返回复选框表中每个单元格的值为TRUE/FALSE的矩阵.

App

应用程序的代码非常简单明了.

首先，我们使用第一个helper函数创建一个示例表.

然后，我们使用DT呈现表格，确保在表格上禁用escape(以便可以呈现复选框)、sorting、paging和selection.最重要的是，我们发送preDrawCallback和drawCallback JS函数以确保复选框注册到shiny.

最后，每当用户与表交互时，我们都会调用第二个helper函数来判断复选框状态.你可以用这些信息做任何你想做的事情.

Code

# Checkbox Table Demo

library(shiny)
library(DT)


#### Helper Functions ####
#' Construct a checkbox table for an app.
construct_checkbox_table <- function(rows,
                                     cols,
                                     rownames,
                                     colnames) {
  checkbox_table <- matrix(
    character(),
    nrow = rows,
    ncol = cols,
    dimnames = list(rownames, colnames)
  )
  
  for (i in seq_len(rows)) {
    for (j in seq_len(cols)) {
      checkbox_table[i, j] <-
        sprintf(
          '<input id="%s,%s" type="checkbox" class="shiny-bound-input" />',
          rownames[[i]],
          colnames[[j]]
        )
    }
  }
  
  checkbox_table
}

#' Get the status of checkboxes in a checkbox table.
evaluate_checkbox_table_status <- function(input, input_table) {
  table_status <-
    matrix(
      logical(),
      nrow = nrow(input_table),
      ncol = ncol(input_table),
      dimnames = list(rownames(input_table), colnames(input_table))
    )
  
  table_rownames <- rownames(input_table)
  table_colnames <- colnames(input_table)
  
  for (i in seq_len(nrow(input_table))) {
    for (j in seq_len(ncol(input_table))) {
      table_status[i, j] <-
        input[[sprintf("%s,%s", table_rownames[[i]], table_colnames[[j]])]]
    }
  }
  
  table_status
}
#### End Helper Functions ####


#### App ####
# Create an example checkbox input table to use for the app
example_checkbox_table <-
  construct_checkbox_table(
    2,
    4,
    rownames = c("Annual Bottom Temp Absolute", "Bottom Temp Anomoly"),
    colnames = c("GOM", "GB", "MAB", "SS")
  )

ui <- fluidPage(DT::DTOutput("selection_table"),
                verbatimTextOutput("table_selections"),)

server <- function(input, output, session) {
  output$selection_table <- DT::renderDT({
    DT::datatable(
      example_checkbox_table,
      escape = FALSE,
      selection = "none",
      options = list(
        dom = "t",
        ordering = FALSE,
        paging = FALSE,
        preDrawCallback = JS(
          'function() { Shiny.unbindAll(this.api().table().node()); }'
        ),
        drawCallback = JS(
          'function() { Shiny.bindAll(this.api().table().node()); } '
        )
      )
    )
  }, server = FALSE)
  
  observeEvent(input$selection_table_cell_clicked, {
    output$table_selections <- renderPrint({
      evaluate_checkbox_table_status(input, example_checkbox_table)
    })
  })
}
#### End App ####

shinyApp(ui, server)