R/Shiny - Scrollable datatable with checkboxes and total count

Question

I have a datatable to which I add a checkbox column, and can click on individual boxes. Also, have an actionButton that can select or deselect all the checkboxes, a total count of the clicked boxes, and a search box. Everything works except for three things:

1. If I click on individual checkboxes, the count doesn't change. (It works correctly, though, for the whole set.)
2. If I click on a few checkboxes and I immediately search for a term or sort by any column, the checkboxes are cleared.
3. There is no sorting for the checkbox column. It would be ideal if sorting the checkboxes could accumulate all those that were clicked at the top, to be able to see in one go what has been selected.

Any idea?

Thanks

library(shiny)
library(DT)

data <- data.frame(
  Checkbox         = rep(FALSE, 20),
  Name             = c("John", "Jane", "Michael", "Sara", "David","John1", "Jane1", "Michael1", "Sara1", "David1",
                       "John2", "Jane2", "Michael2", "Sara2", "David2","John3", "Jane3", "Michael3", "Sara3", "David3"),
  Volume           = round(100 * runif(20,0,1),0),
  stringsAsFactors = FALSE
)

ui <- fluidPage(
  titlePanel("Scrollable Datatable with Checkbox"),
  sidebarLayout(
    sidebarPanel(
      actionButton("selectBtn", "Select/Deselect All"),
      numericInput("selectedCount", "Selected Rows", 0, min = 0, max = nrow(data), width = "100%")
    ),
    mainPanel(
      DTOutput("myTable")
    )
  )
)

server <- function(input, output, session) {
  # Render the datatable
  output$myTable <- renderDT({
    datatable(data, 
              selection    = 'none',
              options      = list(
                scrollX    = TRUE,
                scrollY    = "400px",
                paging     = FALSE,
                searching  = TRUE,
                order      = list(1, 'asc'),
                columnDefs = list(
                  list(className = 'dt-center', targets = c(1, 3)),
                  list(className = 'dt-left', targets = 2),
                  list(targets = 1, render = JS(
                    "function(data, type, full, meta) {",
                    "var checkboxId = 'checkbox_' + meta.row;",
                    "return '<input type=\"checkbox\" id=\"' + checkboxId + '\" class=\"row-checkbox\" ' + (data ? 'checked' : '') + '></input>';",
                    "}"
                  ))
                )
              )
    )
  })
  
  # Select/Deselect all checkboxes     <============== (this works)
  observeEvent(input$selectBtn, {
    if (input$selectBtn %% 2 == 1) {
      data$Checkbox <- TRUE
    } else {
      data$Checkbox <- FALSE
    }
  # Update the datatable
    replaceData(proxy = dataTableProxy("myTable"), data, resetPaging = FALSE)
  # Update the selected count
    updateNumericInput(session, "selectedCount", value = sum(data$Checkbox))
  })
  
  # Row checkbox selection             <============== (this part doesn't work)
  observeEvent(input$myTable_cells_selected, {
    clicked_rows <- unique(input$myTable_cells_clicked$row)
    data$Checkbox[clicked_rows] <- !data$Checkbox[clicked_rows]
  # Update the datatable
    replaceData(proxy = dataTableProxy("myTable"), data, resetPaging = FALSE)
  # Update the selected count
    updateNumericInput(session, "selectedCount", value = sum(data$Checkbox))
  })
}

shinyApp(ui, server)

Answer 1

Use server=FALSE, otherwise you won't be able to get the total count and this is easier.

Here is an app which adresses your issues except the total count (I'll do it later):

library(shiny)
library(DT)

ui <- fluidPage(
  br(),
  fluidRow(
    column(
      6,
      DTOutput("dtable")
    ),
    column(
      6,
      verbatimTextOutput("reactiveDF")
    )
  )
)

checkboxColumn <- function(len, col, ...) { # `col` is the column index
  inputs <- character(len)
  for(i in seq_len(len)) {
    inputs[i] <- as.character(
      checkboxInput(paste0("checkb_", col, "_", i), label = NULL, ...)
    )
  }
  inputs
}

dat0 <- data.frame(
  fruit  = c("apple", "cherry", "pineapple", "pear"),
  letter = c("a", "b", "c", "d")
)

dat1 <- cbind(dat0, bool1 = FALSE, bool2 = FALSE)

dat2 <- cbind(
  dat0,
  check1 = checkboxColumn(nrow(dat0), 3),
  check2 = checkboxColumn(nrow(dat0), 4)
)

js <- function(dtid, cols, ns = identity) {
  code <- vector("list", length(cols))
  for(i in seq_along(cols)) {
    col <- cols[i]
    code[[i]] <- c(
      sprintf(
        "$('body').on('click', '[id^=checkb_%d_]', function() {",
        col),
      "  var id = this.getAttribute('id');",
      sprintf(
        "  var i = parseInt(/checkb_%d_(\\d+)/.exec(id)[1]);",
        col),
      "  var value = $(this).prop('checked');",
      sprintf(
        "  var info = [{row: i, col: %d, value: value}];",
        col),
      sprintf(
        "  Shiny.setInputValue('%s', info);",
        ns(sprintf("%s_cell_edit:DT.cellInfo", dtid))
      ),
      "});"
    )
  }
  do.call(c, code)
}

checkboxesColumns <- c(3, 4)

render <- function(col) { 
sprintf('
function(data, type, row, meta) {
  if(type == "sort") { 
    var i = meta.row + 1;
    var $box = $("#checkb_%d_" + i);
    data = $box.prop("checked") ? "true" : "false";
  }
  return data;
}', col)
}

server <- function(input, output, session) {
  
  Dat <- reactiveVal(dat1)
  
  output[["dtable"]] <- renderDT({
    datatable(
      dat2, 
      rownames = TRUE,
      escape = FALSE,
      editable = list(
        target = "cell", disable = list(columns = checkboxesColumns)
      ),
      selection = "none",
      callback = JS(js("dtable", checkboxesColumns)), 
      options = list(
        columnDefs = list(
         list(targets = 3, render = JS(render(3))),
         list(targets = 4, render = JS(render(4)))
        )
      )
    )
  }, server = FALSE)
  
  observeEvent(input[["dtable_cell_edit"]], { 
    info <- input[["dtable_cell_edit"]] # this input contains the info of the edit
    Dat(editData(Dat(), info))
  })
  
  output[["reactiveDF"]] <- renderPrint({ 
    Dat()
  })
  
}

shinyApp(ui, server)