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

Question

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:

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.

What exactly did you try and how did it not work for your specific requirements. It's better to show us the code you tried so we can help you fix it rather than write something from scratch for you. — MrFlick, Aug 01 '23 at 15:43
I've tried a few different solutions, and each seems flawed. I've just added one example @MrFlick — ddm_ingram, Aug 01 '23 at 15:59

Stéphane Laurent · Accepted Answer · 2023-08-04T08:13:00.170

library(shiny)
library(DT)

rowName <- function(L) {
  as.character(
    checkboxInput(paste0("row", L), label = L, width = "150px")
  )
}
rowNames <- vapply(LETTERS[1:6], rowName, character(1))


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

server <- function(input, output){
  dat <- data.frame(
    vapply(LETTERS[1:6], function(i){
      as.character(
        checkboxInput(paste0("col1-", i), label = NULL, width = "150px")
      )
    }, character(1)),
    vapply(LETTERS[1:6], function(i){
      as.character(
        checkboxInput(paste0("col2-", i), label = NULL, width = "150px")
      )
    }, character(1)),
    vapply(LETTERS[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"))
  )
  
  rownames(dat) <- rowNames
  
  output$myTable <- renderDT({
    datatable(
      dat, 
      escape = FALSE,
      select = "none",
      options = list(
        columnDefs = list(
          list(targets = c(1, 2, 3), orderable = FALSE, className = "dt-center")
        ),
        initComplete = JS(
          "function() {",
          "  $('#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);",
          "    });",
          "  });",
          "  $('#rowA').on('click', function(){",
          "    var cboxes = $('[id$=-A]');",
          "    var checked = $('#rowA').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowB').on('click', function(){",
          "    var cboxes = $('[id$=-B]');",
          "    var checked = $('#rowB').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowC').on('click', function(){",
          "    var cboxes = $('[id$=-C]');",
          "    var checked = $('#rowC').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowD').on('click', function(){",
          "    var cboxes = $('[id$=-D]');",
          "    var checked = $('#rowD').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowE').on('click', function(){",
          "    var cboxes = $('[id$=-E]');",
          "    var checked = $('#rowE').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowF').on('click', function(){",
          "    var cboxes = $('[id$=-F]');",
          "    var checked = $('#rowF').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "}"
        ),
        preDrawCallback = 
          JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = 
          JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  })
}

shinyApp(ui, server)

EDIT: a "select all" checkbox

library(shiny)
library(DT)
library(htmltools)

rowName <- function(L) {
  as.character(
    checkboxInput(paste0("row", L), label = L, width = "150px")
  )
}
rowNames <- vapply(LETTERS[1:6], rowName, character(1))


sketch <- htmltools::withTags(
  table(
    class = "display",
    thead(
      tr(
        th(HTML(as.character(checkboxInput("allboxes", label = "ALL", width = "150px")))), 
        th(HTML(as.character(checkboxInput("col1", label = "1", width = "150px")))),
        th(HTML(as.character(checkboxInput("col2", label = "2", width = "150px")))),
        th(HTML(as.character(checkboxInput("col3", label = "3", width = "150px"))))
      )
    )
  )
)



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

server <- function(input, output){
  dat <- data.frame(
    vapply(LETTERS[1:6], function(i){
      as.character(
        checkboxInput(paste0("col1-", i), label = NULL, width = "150px")
      )
    }, character(1)),
    vapply(LETTERS[1:6], function(i){
      as.character(
        checkboxInput(paste0("col2-", i), label = NULL, width = "150px")
      )
    }, character(1)),
    vapply(LETTERS[1:6], function(i){
      as.character(
        checkboxInput(paste0("col3-", i), label = NULL, width = "150px")
      )
    }, character(1))
  )
  
  rownames(dat) <- rowNames
  
  output$myTable <- renderDT({
    datatable(
      dat, container = sketch,
      escape = FALSE,
      select = "none",
      options = list(
        columnDefs = list(
          list(targets = c(1, 2, 3), orderable = FALSE, className = "dt-center")
        ),
        initComplete = JS(
          "function() {",
          "  $('#allboxes').on('click', function(){",
          "    var cboxes = $('input[type=checkbox]');",
          "    var checked = $('#allboxes').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#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);",
          "    });",
          "  });",
          "  $('#rowA').on('click', function(){",
          "    var cboxes = $('[id$=-A]');",
          "    var checked = $('#rowA').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowB').on('click', function(){",
          "    var cboxes = $('[id$=-B]');",
          "    var checked = $('#rowB').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowC').on('click', function(){",
          "    var cboxes = $('[id$=-C]');",
          "    var checked = $('#rowC').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowD').on('click', function(){",
          "    var cboxes = $('[id$=-D]');",
          "    var checked = $('#rowD').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowE').on('click', function(){",
          "    var cboxes = $('[id$=-E]');",
          "    var checked = $('#rowE').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "  $('#rowF').on('click', function(){",
          "    var cboxes = $('[id$=-F]');",
          "    var checked = $('#rowF').is(':checked');",
          "    cboxes.each(function(i, cbox) {",
          "      $(cbox).prop('checked', checked);",
          "    });",
          "  });",
          "}"
        ),
        preDrawCallback = 
          JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = 
          JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  })
}

shinyApp(ui, server)

A great start thank you. Any ideas about adding a button top-left for all the checkboxes, and/or making the whole thing more compact? — ddm_ingram, Aug 02 '23 at 09:16
@ddm_ingram See my edit for the "select all" checkbox. To make the whole think more compact, I believe this question has already been addressed on StackOverflow. First you can reduce the widths. Then you will need some CSS. — Stéphane Laurent, Aug 04 '23 at 08:14

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

Attempted js

An example I've tried

1 Answers1

EDIT: a "select all" checkbox