mardi 1 août 2023

In R Shiny, how can I make a table of checkboxes that also has 'select all' checkboxes for individual rows/columns?

Using R Shiny, I want to display a table (e.g. via the "DT" package) with each cell containing a single checkbox. Next to each row and column heading I want to display a 'select all'/'master checkbox', which upon selecting, will select all the checkboxes in the corresponding row or column. As an additional feature, a checkbox in the top-left cell would select all checkboxes in the table. An example:

enter image description here

Attempted js

I found an example of this functionality with a master checkbox for one column here (using some javascript) but couldn't work out how to extend this to my requirements.

An example I've tried

library(shiny)
library(DT)

ui <- fluidPage(
    # Sidebar panel
    sidebarPanel(),
    
    # Main panel with the table
    mainPanel(
        DTOutput("myTable")
    )
)

server <- function(input, output){
    dat <- data.frame(
        vapply(1:6, function(i){
            as.character(
                checkboxInput(paste0("col1-", i), label = NULL, width = "150px")
            )
        }, character(1)),
        vapply(1:6, function(i){
            as.character(
                checkboxInput(paste0("col2-", i), label = NULL, width = "150px")
            )
        }, character(1)),
        vapply(1:6, function(i){
            as.character(
                checkboxInput(paste0("col3-", i), label = NULL, width = "150px")
            )
        }, character(1))
    )
    
    names(dat) <- c(
        as.character(checkboxInput("col1", label = "1", width = "150px")),
        as.character(checkboxInput("col2", label = "2", width = "150px")),
        as.character(checkboxInput("col3", label = "3", width = "150px"))
    )
    
    row_names <- LETTERS[1:6]
    rownames(dat) <- row_names
    
    output$myTable <- renderDT({
        datatable(
            dat, 
            escape = FALSE,
            options = list(
                columnDefs = list(
                    list(targets = c(1, 2, 3), orderable = FALSE, className = "dt-center")
                )
            ),
            callback = JS(
                "$('#col1').on('click', function(){",
                "  var cboxes = $('[id^=col1-]');",
                "  var checked = $('#col1').is(':checked');",
                "  cboxes.each(function(i, cbox) {",
                "    $(cbox).prop('checked', checked);",
                "  });",
                "});",
                "$('#col2').on('click', function(){",
                "  var cboxes = $('[id^=col2-]');",
                "  var checked = $('#col2').is(':checked');",
                "  cboxes.each(function(i, cbox) {",
                "    $(cbox).prop('checked', checked);",
                "  });",
                "});",
                "$('#col3').on('click', function(){",
                "  var cboxes = $('[id^=col3-]');",
                "  var checked = $('#col3').is(':checked');",
                "  cboxes.each(function(i, cbox) {",
                "    $(cbox).prop('checked', checked);",
                "  });",
                "});"
            )
        )
    })
}

shinyApp(ui, server)

This is a start, but I can't work out how to get master checkboxes next to the rows, nor one in the top-left for all boxes. Also, the whole thing is a bit big - would be great to be more compact.




Aucun commentaire:

Enregistrer un commentaire