顶部的 R 闪亮 DT 复选框可勾选/取消勾选下面的所有复选框答案

【问题标题】：R shiny DT checkboxes on top to tick/untick all the checkboxes below顶部的 R 闪亮 DT 复选框可勾选/取消勾选下面的所有复选框
【发布时间】：2021-02-14 15:21:16
【问题描述】：

我正在寻找一种简单的方法来选择按行组织的具有某些属性（即这些数据的收集年份）按列组织的数据。列将是“2016”、“2017”、“2018”，并且在这些列中的每一列下方的每一行上，应该有一个复选框，指示是否应该选择该行和今年的数据。做出此选择后，可以通过此选择上的按钮执行某些操作（例如导出）。所以，没什么特别的。因为有大约。总共 1 000 行我想通过允许用户选择或取消选择一整列（即一整年）来加快选择过程。

如果可能的话，我想用DT 来做这件事。我已经看到了一些相关的线程，例如here 和there，但没有我需要的“系统性”（即将选择/取消选择所有复选框放在列子集的顶部）。

您知道使用DT 的一种快速简单的方法吗？

另一种选择是rhandsontable，但我觉得这有点像用锤子杀死苍蝇......

[编辑]：在下面添加了代表

灵感来自https://github.com/rstudio/DT/issues/93#issuecomment-111001538

    library(shiny)
    library(DT)

    # create a character vector of shiny inputs
    shinyInput <- function(FUN, len, id, ...)
    {
        inputs <- character(len)
        
        for (i in seq_len(len))
        {
            inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
        }
        inputs
    }

    # obtain the values of inputs
    shinyValue <- function(id, len)
    {
        unlist(lapply(seq_len(len), function(i)
        {
            value <- input[[paste0(id, i)]]
            if (is.null(value)) NA else value
        }))
    }

    Years <- paste0("Year_", 2016:2020)
    MyDataFrame <- data.frame(matrix(nrow = 1000, ncol = 1 + length(Years)), stringsAsFactors = FALSE)
    colnames(MyDataFrame) <- c("Group", Years)
    MyDataFrame[names(MyDataFrame) == "Group"] <- paste0("Group_", 1:1000)
    #MyDataFrame[names(MyDataFrame) %in% Years] <- TRUE
    MyDataFrame[names(MyDataFrame) %in% Years] <- lapply(X = Years, FUN = function(x){shinyInput(checkboxInput, 1000, paste0('v_', x, '_'), value = TRUE)})

    ui <- fluidPage(
        sidebarLayout(
            sidebarPanel(
                h4("Filter"),
                width = 2
            ),
            mainPanel(
                DT::dataTableOutput("MyTable"),
                width = 10
            )
        )
    )

    server <- function(input, output, session) {
        output$MyTable = DT::renderDataTable(MyDataFrame, server = FALSE, escape = FALSE, selection = 'none', options = list(
            preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
            drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
            )
        )
    }

    shinyApp(ui = ui, server = server, enableBookmarking = "server")

【问题讨论】：

嗨 Olivier，不要仅仅要求一个功能，而是显示一个包含数据和您的一些努力的最小可重现示例。即使您不知道从哪里开始，当有一些代码可以构建时，也更有可能获得一些帮助。
谢谢@mnist。在我原来的问题中添加了 Reprex。
实际上我想了一个技巧来实现我正在寻找的东西：我可以创建一个名为“下面的所有行”的人为第一行来（取消）选择下面的所有行（一些观察者在第一行的复选框）。但是，这将具有在转到另一个页面时不再可见的缺点。
似乎即使有了reprex，我的问题也不是很鼓舞人心^^
但也许@mnist 你在等待reprex 时有答案？

标签： r shiny dt rhandsontable

【解决方案1】：

类似的东西：

library(DT)

dat <- data.frame(
  vapply(1:10, function(i){
    as.character(
      checkboxInput(paste0("cbox2018-", i), label = NULL, width = "150px")
    )
  }, character(1)),
  rpois(10, 100),
  rpois(10, 50)
)
names(dat) <- c(
  as.character(
    checkboxInput("cbox2018", label = "2018", width = "150px")
  ),
  "foo",
  "bar"
)

datatable(
  dat, 
  escape = FALSE,
  options = list(
    columnDefs = list(
      list(targets = 1, orderable = FALSE, className = "dt-center")
    )
  ),
  callback = JS(
    "$('#cbox2018').on('click', function(){",
    "  var cboxes = $('[id^=cbox2018-]');",
    "  var checked = $('#cbox2018').is(':checked');",
    "  cboxes.each(function(i, cbox) {",
    "    $(cbox).prop('checked', checked);",
    "  });",
    "});"
  )
)

并为 Shiny 添加preDrawCallback 和drawCallback。

【讨论】：