R shiny DT checkboxes on top to tick/untick all the checkboxes below

Question

I'm looking for a simple way to select data organised by row with some attributes (namely, year of collection of these data) by column. The columns would be '2016', '2017', '2018' and on each row below each of these columns there should be a checkbox indicating whether the data on this row and for this year should be selected. After this selection has been made, some action (e.g. export) could be performed through a button on this selection. So, nothing exceptional. As there are approx. 1 000 rows in total I would like to speed up a bit the selection proces by allowing the user to select or unselect a whole column (i.e. a whole year).

If possible I would like to do that with DT. I saw already some related threads, here and there, for instance, but nothing "systematic" (i.e. put select/unselect all checkboxes on top of a subset of columns) as I need here.

Do you know a quick and simple way to do that with DT?

An alternative would be with rhandsontable but I have the feeling it's somehow like using a hammer to kill a fly...

[EDIT]: Added reprex below

Inspired from 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")

I made progress towards what I am ultimately looking for but I still have an issue: in the reprex below, only the check boxes on the first page are activated or deactivated. Would someone know how to extend the (un)select all effect to all pages, i.e. to the whole table?

library(shiny)
#library(shinyjs)
library(DT)

Generate_shinyInputs <- function(FUN, Range, id, Label, ...)
{
    vapply(Range, function(i){as.character(FUN(paste0(id, i), label = if(!is.null(Label)) i else NULL, width = "150px", ...))}, character(1))
}

Years <- 2016:2020
Years_Augmented <- c(Years, "All_Years")
nRows <- 400
MyDataFrame <- data.frame(matrix(nrow = nRows, ncol = 2 + length(Years_Augmented)), stringsAsFactors = FALSE)
colnames(MyDataFrame) <- c("Group", "Country", Years_Augmented)
MyDataFrame[names(MyDataFrame) == "Group"] <- paste0("Group_", 1:nRows)
MyDataFrame[names(MyDataFrame) == "Country"] <- rep(c("AT", "BE", "BG", "CY", "DE", "ES", "FI", "GR", "HU", "IE", "IT"), length.out = nRows)
MyDataFrame[names(MyDataFrame) %in% Years_Augmented] <- lapply(X = Years_Augmented, FUN = function(x){Generate_shinyInputs(checkboxInput, 1:nRows, paste0("CheckBox_", x, "_"), NULL, value = TRUE)})
colnames(MyDataFrame)[names(MyDataFrame) %in% Years_Augmented] <- Generate_shinyInputs(checkboxInput, Years_Augmented, "CheckBox_", TRUE, value = TRUE)

ui <- fluidPage(
        mainPanel(
            DT::dataTableOutput("MyTable"),
            width = 10
        )
    )

server <- function(input, output, session) {
    # Generate the observe events for the columns check boxes (i.e. on the top row) - Total number of check boxes to be observed = number of years + 1 ('All_Years')
    Generate_observeEvent_Columns <- function(Year)
    {
        observeEvent(input[[paste0("CheckBox_", Year)]],
        {
            CheckBox.Value <- input[[paste0("CheckBox_", Year)]]
            
            if(Year == "All_Years") # Each and every row of each and every column Years_Augmented
            {
                lapply(X = Years, FUN = function(y){lapply(X = 1:nRows, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", y, "_", x), value = CheckBox.Value)})})
                lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x), value = CheckBox.Value)})
            }
            # Only each and every row of the column 'Year'
            lapply(X = 1:nRows, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", Year, "_", x), value = CheckBox.Value)})
        })#, ignoreNULL = TRUE, ignoreInit = TRUE)
    }
    
    # Generate the observe events for each row of the column 'All_Years' check boxes - Total number of check boxes to be observed = number of rows (groups)
    Generate_observeEvent_Rows <- function(Row)
    {
        observeEvent(input[[paste0("CheckBox_All_Years_", Row)]],
        {
            CheckBox.Value <- input[[paste0("CheckBox_All_Years_", Row)]]
            print(Row)
            
            lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x, "_", Row), value = CheckBox.Value)})
        })#, ignoreNULL = TRUE, ignoreInit = TRUE)
    }
    
    lapply(X = Years_Augmented, FUN = function(x){Generate_observeEvent_Columns(x)})
    lapply(X = 1:nRows, FUN = function(x){Generate_observeEvent_Rows(x)})
    
    # filter = 'top', 
    #output$MyTable = DT::renderDataTable(MyDataFrame, rownames = FALSE, server = FALSE, escape = FALSE, selection = 'none')
    output$MyTable = DT::renderDataTable(MyDataFrame, rownames = FALSE, 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")

[EDIT]: I'm still working on this problem. I recently split it into simpler problems and by doing so I found a new issue (described after the reproducible example). I am now dynamically printing the values of the relevant inputs to better understand how everything works. The focus is here on the function Generate_observeEvent_Rows.

Below is a reproducible example:


library(shiny)
#library(shinyjs)
library(DT)

Generate_shinyInputs <- function(FUN, Range, id, Label, ...)
{
    vapply(Range, function(i){as.character(FUN(paste0(id, i), label = if(!is.null(Label)) i else NULL, width = "150px", ...))}, character(1))
}

Years <- 2016:2020
Years_Augmented <- c(Years, "All_Years")
nRows <- 40
# 2 + length(Years_Augmented): the first 2 columns are 'Group' and 'Country'
# The next columns are, at first, numbers (the reporting years), except for the last one, 'All_Years'
MyDataFrame <- data.frame(matrix(nrow = nRows, ncol = 2 + length(Years_Augmented)), stringsAsFactors = FALSE)
colnames(MyDataFrame) <- c("Group", "Country", Years_Augmented)
MyDataFrame[names(MyDataFrame) == "Group"] <- paste0("Group_", 1:nRows)
MyDataFrame[names(MyDataFrame) == "Country"] <- rep(c("AT", "BE", "BG", "CY", "DE", "ES", "FI", "GR", "HU", "IE", "IT"), length.out = nRows)
# The cells of the data.frame 'MyDataFrame' in the columns 'Years_Augmented' are checkboxInputs. They are named 'CheckBox_2016_1' where '2016' is the year from 'Years_Augmented' and '1' is the row ID.
MyDataFrame[names(MyDataFrame) %in% Years_Augmented] <- lapply(X = Years_Augmented, FUN = function(x){Generate_shinyInputs(checkboxInput, 1:nRows, paste0("CheckBox_", x, "_"), NULL, value = TRUE)})
# The very names of the last columns ('Years_Augmented') of the data.frame 'MyDataFrame' are thereafter transformed into checkboxInputs. They are named 'CheckBox_2016' where '2016' is the year of the original version of 'Years_Augmented'. The last column then generates 'CheckBox_All_Years'.
colnames(MyDataFrame)[names(MyDataFrame) %in% Years_Augmented] <- Generate_shinyInputs(checkboxInput, Years_Augmented, "CheckBox_", TRUE, value = TRUE)

ui <- fluidPage(
        mainPanel(
            DT::dataTableOutput("MyTable"),
            width = 10
        )
    )

server <- function(input, output, session) {
    # Generate the observe events for the columns check boxes (i.e. on the top row) - Total number of check boxes to be observed = number of years + 1 ('All_Years')
    Generate_observeEvent_Columns <- function(Year)
    {
        observeEvent(input[[paste0("CheckBox_", Year)]],
        {
            CheckBox.Value <- input[[paste0("CheckBox_", Year)]]
            
            print(paste0("Value of the observed variable '", paste0("CheckBox_", Year), "' = ", CheckBox.Value))
            
            if(Year == "All_Years") # Each and every row of each and every column Years_Augmented
            {
                lapply(X = Years, FUN = function(y){lapply(X = 1:nRows, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", y, "_", x), value = CheckBox.Value); print(paste0("After update: ", input[[paste0("CheckBox_", y, "_", x)]]))})})
                lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x), value = CheckBox.Value); print(paste0("After update: ", input[[paste0("CheckBox_", x)]]))})
            }
            else    # Only one single year was (de)selected (checked/unchecked)
            {
                lapply(X = 1:nRows, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", Year, "_", x), value = CheckBox.Value); print(paste0("After update: ", input[[paste0("CheckBox_", Year, "_", x)]]))})
            }
        })#, ignoreNULL = TRUE, ignoreInit = TRUE)
    }
    
    # Generate the observe events for each row of the column 'All_Years' check boxes (not the top row but the rows below) - Total number of check boxes to be observed = number of rows (groups)
    Generate_observeEvent_Rows <- function(Row)
    {
        observeEvent(input[[paste0("CheckBox_All_Years_", Row)]],
        {
            CheckBox.Value <- input[[paste0("CheckBox_All_Years_", Row)]]
            #print(Row)
            print(paste0("Value of the observed variable '", paste0("CheckBox_All_Years_", Row), "' = ", CheckBox.Value))
            
            lapply(X = Years, FUN = function(x){print(paste0("Before update of '", paste0("CheckBox_", x, "_", Row), "': ", input[[paste0("CheckBox_", x, "_", Row)]]))})
            lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x, "_", Row), value = CheckBox.Value)})
            lapply(X = Years, FUN = function(x){print(paste0("After update of '", paste0("CheckBox_", x, "_", Row), "': ", input[[paste0("CheckBox_", x, "_", Row)]]))})
        })#, ignoreNULL = TRUE, ignoreInit = TRUE)
    }
    
    #lapply(X = Years_Augmented, FUN = function(x){Generate_observeEvent_Columns(x)})
    lapply(X = 1:nRows, FUN = function(x){Generate_observeEvent_Rows(x)})
    
    # filter = 'top', 
    #output$MyTable = DT::renderDataTable(MyDataFrame, rownames = FALSE, server = FALSE, escape = FALSE, selection = 'none')
    #'MyDataFrame' should be updated every time a check box is clicked!
    output$MyTable <- DT::renderDataTable(MyDataFrame, rownames = FALSE, 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());}')
        )
    )
    
    #proxy <- DT::dataTableProxy("MyTable")
}

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

What I don't understand is that when I click on any of the 'All_Years' column checkbox on one arbitrary row (except of course on the top row, the header), the behaviour of the checkboxes on the same row from 2016 to 2020 is in line with what is expected (i.e. when 'All_Years' on the same row is checked, they become checked, when 'All_Years' on the same row is unchecked, they become unchecked) but their value is not correctly updated: they are always "lagging one step behind".

Do you know why?

Besides, interestingly, we see that only the first 10 rows (the visible part of the table, the current page) of the inputs values are initially displayed in the console (with print). But that's the next problem to be tackled.

Hi Olivier, Instead of just asking for a feature, show a minimal reproducible example which contains data and some of your effort. Even if you have no idea where to start with, it is more likely to get some help when there is some code to build on. — mnist, Nov 01 '20 at 23:00
Actually I thought about a trick to achieve what I am looking for: I could create an artificial first row entitled 'All rows below' to (un)select all the rows below (with some observer on the check boxes of this first rows). However this would have the drawback of not being visible anymore when going to another page. — Olivier7121, Nov 02 '20 at 12:07
It seems that even with the reprex my question is not really inspiring^^ — Olivier7121, Nov 02 '20 at 21:34
But maybe @mnist you have an answer as you were waiting for a reprex? — Olivier7121, Nov 04 '20 at 20:43

Stéphane Laurent · Accepted Answer · 2022-01-31T08:34:40.960

Something like that:

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);",
    "  });",
    "});"
  )
)

And add the preDrawCallback and the drawCallback for Shiny.

EDIT

As noted by @Olivier in a comment, the box-checking is performed on the current page only. Here is a solution to this issue:

library(shiny)
library(DT)

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


ui <- basicPage(
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session){
  
  output[["dtable"]] <- renderDT({
    datatable(
      dat, 
      escape = FALSE,
      options = list(
        columnDefs = list(
          list(targets = 1, orderable = FALSE, className = "dt-center")
        ),
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      ),
      callback = JS(
        "$('#cbox2018').on('click', function(){",
        "  var cboxes = $('[id^=cbox2018-]');",
        "  var checked = $('#cbox2018').is(':checked');",
        "  cboxes.each(function(i, cbox) {",
        "    $(cbox).prop('checked', checked);",
        "  });",
        "});",
        "table.on('page.dt', function(){",
        "  setTimeout(function(){",
        "    var cboxes = $('[id^=cbox2018-]');",
        "    var checked = $('#cbox2018').is(':checked');",
        "    cboxes.each(function(i, cbox) {",
        "      $(cbox).prop('checked', checked);",
        "    });",
        "  });",
        "});"
      )
    )
  }, server = FALSE)
}

shinyApp(ui, server)

Many thanks @Stéphane Laurent for your answer! And apologies that I only now notice it... Apparently something went wrong with my email alerts. I made progress towards a complete solution but I'm not completely there yet. — Olivier7121, Jan 29 '22 at 22:00
BTW, there is the same issue in the code you suggested: if the data are displayed on more than one page, the selection is only performed on the current/active page. And it seems there is a closely related bug with Shiny: when I am not on the first page and that I select/unselect a whole year (top row) or all years (top right corner), then the app jumps to the first page and performs the select/unselect operation on the first page and not on the intended page. See https://stackoverflow.com/questions/53370892/r-shiny-data-table-renderdatatable-reloads-to-first-page-when-user-is-on-a-d — Olivier7121, Jan 30 '22 at 09:52
I couldn't try your solution earlier, @Stéphane Laurent. Now I did and I noticed 2 issues: 1) the app still jumps to the first page when an input is selected on another page (I will try to fix this with the help of the previous link), and 2) not all inputs are updated when clicking on one top row check box: the update is performed only by going 1 page forward and then 1 page backward. — Olivier7121, Feb 02 '22 at 07:29
For the time being I haven't found any satisfactory solution yet. — Olivier7121, Feb 09 '22 at 06:32
Plus, a simple selection of one single cell is not stored anymore when jumping to another page and going back to the initial page where the change was made. — Olivier7121, May 18 '22 at 05:43

Olivier7121 · Answer 2 · 2022-07-15T18:26:49.837

After 2 long sessions of intensive programming, I finally managed to get exactly what I was ultimately looking for. It was a painful but interesting and rewarding journey. The workaround posted by @ismirsehregal here was pivotal for me to find this solution: many thanks!

Below the code (a bit long):

library(shiny)
library(DT)
#library(magrittr)

Generate_shinyInputs <- function(FUN, Range, id, Label, Value)
{
    vapply(Range, function(i){as.character(FUN(inputId = paste0(id, i), label = if(!is.null(Label)) i else NULL, value = Value[which(Range == i)], width = "150px"))}, character(1))
}

Years <- 2016:2020
Years_Augmented <- c(Years, "All_Years")
nRows <- 400
# ncol of 'DataFrame4ShinySelection' = 2 + length(Years_Augmented): the first 2 columns are 'Group' and 'Country'
# The next columns are, at first, figures/numbers (the reporting years), except for the last one, 'All_Years'
# The very first line/row is for the header of 'DataFrame4ShinyDisplay'
# The subsequent lines/rows (from 2 onwards) are for the subsequent lines/rows of 'DataFrame4ShinyDisplay'
# Actually, it is not necessary to have the first row (header of 'DataFrame4ShinyDisplay') and the last column ('All_Years') in 'DataFrame4ShinySelection' as they drive the other cells; these other cells are the real target.
DataFrame4ShinySelection <- data.frame(matrix(nrow = 1 + nRows, ncol = 2 + length(Years_Augmented)), stringsAsFactors = FALSE)
colnames(DataFrame4ShinySelection) <- c("Group", "Country", Years_Augmented)
DataFrame4ShinySelection[names(DataFrame4ShinySelection) == "Group"] <- c("Group_Header", paste0("Group_", 1:nRows))
DataFrame4ShinySelection[names(DataFrame4ShinySelection) == "Country"] <- c("Country_Header", rep(c("AT", "BE", "BG", "CY", "DE", "ES", "FI", "GR", "HU", "IE", "IT"), length.out = nRows))
# Within the columns 'Years_Augmented', the cells of the data.frame:
#   - 'DataFrame4ShinyDisplay' are checkboxInputs. They are named 'CheckBox_2016_1' where '2016' is the year from 'Years_Augmented' and '1' is the row ID.
#   - 'DataFrame4ShinySelection' are booleans (TRUE/FALSE) storing the results of the associated checkboxes. All checkboxes are initialised as checked (TRUE).
DataFrame4ShinySelection[names(DataFrame4ShinySelection) %in% Years_Augmented] <- TRUE

# First line/row of 'DataFrame4ShinySelection' is the header of 'DataFrame4ShinyDisplay'
DataFrame4ShinyDisplay <- DataFrame4ShinySelection[-1,]

Generate_DataFrame4ShinyDisplay <- function(InputDataFrame, Vector_Columns, Vector_Rows)
{
    # checkboxInputs are named 'CheckBox_2016_1' where '2016' is the year from 'Years_Augmented' and '1' is the row ID.
    DataFrame4ShinyDisplay[which(names(InputDataFrame) %in% Vector_Columns)][Vector_Rows,] <<- lapply(X = Vector_Columns, FUN = function(x){Generate_shinyInputs(checkboxInput, Vector_Rows, paste0("CheckBox_", x, "_"), NULL, Value = InputDataFrame[names(InputDataFrame) == x][1 + Vector_Rows,])})
    # The very names of the last columns ('Years_Augmented') of the data.frame 'DataFrame4ShinyDisplay' are thereafter transformed into checkboxInputs.
    # They are named 'CheckBox_2016' where '2016' is the year of 'Years_Augmented'. The last column then generates 'CheckBox_All_Years'.
    colnames(DataFrame4ShinyDisplay)[which(names(InputDataFrame) %in% Vector_Columns)] <<- Generate_shinyInputs(checkboxInput, Vector_Columns, "CheckBox_", TRUE, Value = unlist(unname(InputDataFrame[names(InputDataFrame) %in% Vector_Columns][1,])))
    DataFrame4ShinyDisplay
}

#Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection, Years_Augmented, 1:nRows)

ui <- fluidPage(
        
        mainPanel(
            DT::dataTableOutput("MyTable"),
            actionButton(inputId = "Button_Export_Selection", label = "Export selection"),
            #submitButton("Export selection", icon("file-export")),
            width = 10
        )
    )

server <- function(input, output, session) {
    # Generate the observe events for the columns check boxes (i.e. on the top row) - Total number of check boxes to be observed = number of years + 1 ('All_Years')
    Generate_observeEvent_Columns <- function(Year)
    {
        observeEvent(input[[paste0("CheckBox_", Year)]],
        {
            CheckBox.Value <- input[[paste0("CheckBox_", Year)]]
            # Indices of rows on all pages (after the table is filtered by the search strings)
            FilteredRows <- input[["MyTable_rows_all"]]
            #print(paste0("Filtered rows = ", FilteredRows))
            Vector_Rows <- intersect(FilteredRows, 1:nRows)
            #print(paste0("Vector_Rows = ", Vector_Rows))
            
            if(Year == "All_Years") # Each and every row of each and every column Years_Augmented
            {
                #lapply(X = Years, FUN = function(y){lapply(X = 1:nRows, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", y, "_", x), value = CheckBox.Value); print(paste0("After update: ", input[[paste0("CheckBox_", y, "_", x)]]))})})
                #lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x), value = CheckBox.Value); print(paste0("After update: ", input[[paste0("CheckBox_", x)]]))})
                if(CheckBox.Value != DataFrame4ShinySelection[names(DataFrame4ShinySelection) == 'All_Years'][1,])
                {
                    DataFrame4ShinySelection[c(1, Vector_Rows + 1), names(DataFrame4ShinySelection) %in% Years_Augmented] <<- CheckBox.Value
                    DT::replaceData(MyTable_proxy, Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection, Years_Augmented, Vector_Rows), resetPaging = FALSE, rownames = FALSE)
                    lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x), value = CheckBox.Value)})
                }
            }
            else    # Only one single year was (de)selected (checked/unchecked)
            {
                #lapply(X = 1:nRows, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", Year, "_", x), value = CheckBox.Value); print(paste0("After update: ", input[[paste0("CheckBox_", Year, "_", x)]]))})
                if(CheckBox.Value != DataFrame4ShinySelection[names(DataFrame4ShinySelection) == Year][1,])
                {
                    DataFrame4ShinySelection[c(1, Vector_Rows + 1), names(DataFrame4ShinySelection) == Year] <<- CheckBox.Value
                    DT::replaceData(MyTable_proxy, Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection, Year, Vector_Rows), resetPaging = FALSE, rownames = FALSE)
                }
            }
        })#, ignoreNULL = TRUE, ignoreInit = TRUE)
    }
    
    # Generate the observe events for each row of the column 'All_Years' check boxes (not the top row but the rows below) - Total number of check boxes to be observed = number of rows (groups)
    Generate_observeEvent_Rows <- function(Row)
    {
        observeEvent(input[[paste0("CheckBox_All_Years_", Row)]],
        {
            CheckBox.Value <- input[[paste0("CheckBox_All_Years_", Row)]]
            if(CheckBox.Value != DataFrame4ShinySelection[names(DataFrame4ShinySelection) == 'All_Years'][Row + 1,])
            {
                #lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x, "_", Row), value = CheckBox.Value)})
                DataFrame4ShinySelection[names(DataFrame4ShinySelection) %in% Years_Augmented][Row + 1,] <<- CheckBox.Value
                DT::replaceData(MyTable_proxy, Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection, Years_Augmented, Row), resetPaging = FALSE, rownames = FALSE)
            }
            
            #lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x, "_", Row), value = CheckBox.Value)})
        })#, ignoreNULL = TRUE, ignoreInit = TRUE)
    }
    
    #Generate the observe events for all the other checkboxes ("CheckBox_", x, "_", Row) because the selection of these (individual and without side effects on other checkboxes) checkboxes is not saved when e.g. a filter is applied
    # Actually adapt 'Generate_observeEvent_Rows' with 2 arguments: c(Year, Row). Not necessarily...
    Generate_observeEvent_StandaloneCells <- function(Year, Row)
    {
        observeEvent(input[[paste0("CheckBox_", Year, "_", Row)]],
        {
            CheckBox.Value <- input[[paste0("CheckBox_", Year, "_", Row)]]
            if(CheckBox.Value != DataFrame4ShinySelection[names(DataFrame4ShinySelection) == Year][Row + 1,])
            {
                #lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x, "_", Row), value = CheckBox.Value)})
                DataFrame4ShinySelection[names(DataFrame4ShinySelection) == Year][Row + 1,] <<- CheckBox.Value
                DT::replaceData(MyTable_proxy, Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection, Year, Row), resetPaging = FALSE, rownames = FALSE)
            }
        })
    }
    
    lapply(X = Years_Augmented, FUN = function(x){Generate_observeEvent_Columns(x)})
    lapply(X = 1:nRows, FUN = function(x){Generate_observeEvent_Rows(x)})
    lapply(X = Years, FUN = function(Year){lapply(X = 1:nRows, FUN = function(Row){Generate_observeEvent_StandaloneCells(Year, Row)})})
    
    observeEvent(input[["Button_Export_Selection"]],
    {
        #DataFrame4ShinySelection[names(DataFrame4ShinySelection) == 2016] <<- !DataFrame4ShinySelection[names(DataFrame4ShinySelection) == 2016][1,]
        #DT::replaceData(MyTable_proxy, Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection))
        # Copy the Shiny inputs (checkboxes) to 'DataFrame4ShinySelection'
        # First, the header (not really necessary but useful for debugging purposes)
        #lapply(X = Years_Augmented, FUN = function(x){print(paste0(paste0("CheckBox_", x), " = ", input[[paste0("CheckBox_", x)]]))})
        #print(input[[paste0("CheckBox_", Years_Augmented)]])
        #lapply(X = Years_Augmented, FUN = function(x){DataFrame4ShinySelection[names(DataFrame4ShinySelection) == x][1,] <<- input[[paste0("CheckBox_", x)]]})
        #print("Before second lapply")
        #DataFrame4ShinySelection[names(DataFrame4ShinySelection) %in% Years_Augmented][1,] <<- input[[paste0("CheckBox_", Years_Augmented)]]
        # Second, the other (main) checkboxes
        #lapply(X = Years_Augmented, FUN = function(x){DataFrame4ShinySelection[names(DataFrame4ShinySelection) == x][2:(1 + nRows),] <<- input[[paste0("CheckBox_", x, "_", 1:nRows)]]}})
        #lapply(X = Years_Augmented, FUN = function(x){for (i in seq(nRows)){print(paste0(paste0("CheckBox_", x, "_", i), " = ", input[[paste0("CheckBox_", x, "_", i)]])); DataFrame4ShinySelection[names(DataFrame4ShinySelection) == x][1 + i,] <<- ifelse(is.null(input[[paste0("CheckBox_", x, "_", i)]]), DataFrame4ShinySelection[names(DataFrame4ShinySelection) == x][1 + i,], input[[paste0("CheckBox_", x, "_", i)]])}})
        #for (i in seq(nRows)){DataFrame4ShinySelection[names(DataFrame4ShinySelection) == 2017][1 + i,] <<- input[[paste0("CheckBox_", 2017, "_", i)]]}
        #print("After second lapply")
        #TmpData <- DataFrame4ShinySelection
        #TmpData[names(TmpData) %in% Years_Augmented] <- TRUE
        #DT::replaceData(MyTable_proxy, Generate_DataFrame4ShinyDisplay(TmpData))
    })
    
    # output$MyTable = DT::renderDataTable(MyDataFrame, rownames = FALSE, server = FALSE, escape = FALSE, selection = 'none')
    # 'MyDataFrame' should be updated every time a check box is clicked! No, not necessarily
    # For filters below each column name: filter = 'top'
    output$MyTable <- DT::renderDataTable({
        DT::datatable(Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection, Years_Augmented, 1:nRows), rownames = FALSE, escape = FALSE, filter = 'none', selection = 'none', options = list(
        ordering = F,
        #pageLength = 10,
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
    }, server = TRUE)
    
    MyTable_proxy <- DT::dataTableProxy("MyTable")
}

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

Some lessons learnt - some are really tricky and even cryptic:

My function Generate_shinyInputs defined in the 3rd 'answer' was buggy when the Shiny inputs were to be initialised not with a single value but with a whole vector of values: it didn't set the value of the Shiny input correctly when the input as a vector was entered (just interpreted it as a scalar, so only its first value).
I didn't know/never used the functions DT::replaceData and DT::dataTableProxy: that's powerful and clean (no need to write explicit JS code).
I didn't know DT::datatable was necessary within DT::renderDataTable. Without that it doesn't work. I don't understand why to be honest.
To avoid a systematic crash when rownames = FALSE is set in the options of DT::renderDataTable, the same option has to be set in DT::replaceData, e.g. DT::replaceData(MyTable_proxy, Generate_DataFrame4ShinyDisplay(DataFrame4ShinySelection, Years_Augmented, Row), resetPaging = FALSE, rownames = FALSE).
To avoid a systematic crash and unintended sorting operations when checking the header checkboxes, the option ordering = F should be set in the options of DT::renderDataTable.
The option server = TRUE should be set in the options of DT::renderDataTable.
Bookmarking causes a crash when launching the app, hence shinyApp(ui = ui, server = server)#, enableBookmarking = "server").
For some obscure reasons, the header checkboxes (except of course All_Years) are not updated/refreshed automatically when clicking on All_Years; the data are correctly updated but graphically they stay in the same state. That's why I had to add lapply(X = Years, FUN = function(x){updateCheckboxInput(session, paste0("CheckBox_", x), value = CheckBox.Value)}) - again, for pure refreshing graphical reasons as the underlying data are correctly updated.
Perhaps obvious but still, I didn't think about it immediately: even the 'standalone' checkboxes (i.e. the ones that are not on the header and not in the right-hand side column All_Years) should be updated dynamically 'under the hood' with replaceData; indeed, when a filter is applied ('Search' box in the top right-hand corner), the selection is lost.

[EDIT]: Amended the code so that the year selections (in the header) are only applied to the filtered rows if the search function (the filter) is used and not to the whole table/rows:

FilteredRows <- input[["MyTable_rows_all"]]
Vector_Rows <- intersect(FilteredRows, 1:nRows)

R shiny DT checkboxes on top to tick/untick all the checkboxes below

2 Answers2

EDIT

Linked