如何在Shiny的DataTable中限制可勾选的check-boxes数量？

可以通过修改前端JavaScript逻辑实现复选框的勾选数量限制，以下是针对你的代码修改后的完整实现（以最多勾选2个为例，匹配你现有代码的绘图逻辑）：

library("data.table")
library("ggplot2")
library("rlang")
library("shiny")
library("glue")
library("DT")

Data <- data.table(
  Type = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width"),
  ID = glue("ID_{1:4}"),
  Plot = glue::glue('<input type="checkbox" name="selected" value="{1:4}"><br>')
)
ui <- fluidPage(
  fluidRow(
    column(
      6,
      DT::dataTableOutput('table'),
      tags$script(
        HTML(
          '$(document).on("click", "input", function (e) {
              var maxAllowed = 2; // 设置最多勾选数量
              var checkboxes = document.getElementsByName("selected");
              var checkedCount = 0;
              // 统计当前已勾选的数量
              for (var i=0; i<checkboxes.length; i++) {
                if (checkboxes[i].checked) {
                  checkedCount++;
                }
              }
              // 如果当前复选框未勾选，且已达上限，阻止勾选
              if (!this.checked && checkedCount >= maxAllowed) {
                e.preventDefault();
                return;
              }
              // 收集已勾选的选项并传给Shiny
              var checkboxesChecked = [];
              for (var i=0; i<checkboxes.length; i++) {
                if (checkboxes[i].checked) {
                  checkboxesChecked.push(checkboxes[i].value);
                }
              }
            Shiny.onInputChange("checked_rows",checkboxesChecked);
          })'
        )
      )
    ),
    column(
      6,
      plotOutput(outputId = "scatterplot")
    )
  )
)

server <- function(input, output) {
  output$value1 <- renderPrint({
    length(input$checked_rows)
  })
  output$table <- DT::renderDataTable({
    datatable(
      Data,
      escape=F,
      rownames=F, 
      class = 'cell-border compact', 
      options=list(
        ordering=T,
        autowidth=F,
        scrollX = TRUE,
        columnDefs = list(list(className = 'dt-center', targets = "_all"))
      ),
      selection="none"
    )
  })
  observe({
    sel_rows <- as.integer(input$checked_rows)
    if (length(sel_rows) == 2) {
      var_x <- rlang::sym(Data[["Type"]][sel_rows[1]])
      var_y <- rlang::sym(Data[["Type"]][sel_rows[2]])
      output$scatterplot <- renderPlot({
        ggplot(iris, aes(x = !!var_x, y = !!var_y)) + 
          geom_point(aes(col = Species), size = 2) +
          scale_color_discrete(name ="Species") +
          geom_smooth(aes(group=Species, color = Species), method='lm')
      })
    } else {
      # 未选够2个时清空绘图
      output$scatterplot <- renderPlot(NULL)
    }
  })
}

shinyApp(ui = ui, server = server)

关键修改说明： #

• 在JavaScript代码中新增maxAllowed变量，用于设置允许勾选的最大数量（这里设为2，匹配你的绘图逻辑）
• 点击复选框时先统计已勾选数量：
  • 若当前点击的复选框未勾选，且已勾选数量达到上限，则通过e.preventDefault()阻止本次勾选操作
  • 否则正常收集已勾选选项，传递给Shiny的checked_rows输入
• 服务器端新增else分支，当勾选数量不等于2时清空绘图，优化交互体验

内容的提问来源于stack exchange，提问作者Fernando Brito Lopes